#!/usr/bin/perl -w
#
# merge - (c) Kim Holburn 2002
# Script to read a tab delimited text file 
# merge it with a template text file, substituting variables and 
# execute a command for each line (piping the template into the command)
#
# To do: 
# 

sub fail_usage {
  print STDERR "    \n";
  for (@_) {
    print STDERR "$0 error: $_\n";
  }
  if (scalar @_) { print STDERR "    \n"; }
  print STDERR <<EOM;
Usage: 
$0 [opts] [-t template] -d datafile -e command 
$0 [-h|--help]  
   options :  
     [-p <grep pattern> (only data lines that match)]
     [-i (case insensitive match)]
     [-c (complement - only lines which don't match pattern)]
     [-n|--debug (don't really do anything just pretend)]
     [-n|--debug (more than one: be more verbose)]
     [-v|--verbose (verbose)] 
     [-h (this help screen)] 


 This command reads from a tab delimited data file 
 a line at a time. 
 The first line of the data file must contain 
 tab delimited header(variable) names. 
 Variable names must contain only alphanumerics with underscore.
 The template (a text file) and the command can contain
 variables, for example \$name etc.
 For each line of the file the variables are substituted
 into the template and command and the template piped to
 the command.  If no template file is supplied the command is
 just executed.

 Examples:
 ./merge.pl -v -d data.txt -t letter.txt -e 'sendmail \$email'

Note: in the data file TABs are delimiters spaces part of data
-------------------data.txt------------------
docno	doctitle	first	last	sal	email	url
aus4.pdf	Characterising garden capacity under the influence of spatial/temporal correlation	Fred	Smith	Fred	fred.smith\@csiro.au	Fred%20Smith
aus5.pdf	Space-time trellis decoder for spatially correlated gardens	Brian	Jones	Brian	b.jones\@latrobe.edu.au	Brian%20Jones
-------------------data.txt------------------
-------------------letter.txt------------------
Subject: here is that document \$docno 
Reply-To: joan.brown\@gardens.com.au
To: \$email

Dear \$sal
  Here is the document I said I would send you titled "\$doctitle" \$docno as a new member of Gardens Australia.

The document is available at the following url:
http://gardens.com.au/gardens2003/documents/\$docno

\$docno
\$doctitle

-- 
Joan Brown
Gardens Australia
mailto:Joan.Brown\@gardens.com.au
http://gardens.com.au/~joan/
-------------------letter.txt------------------

EOM
#'
  exit scalar @_;
}

$debug=0;
$verbose=0;
while ($ARGV=$ARGV[0]) {
  if ($ARGV eq '-e') {
    shift @ARGV;
    if (!($ARGV = $ARGV[0])) { fail_usage ("-e needs a command"); }
    if ($ARGV =~ /^-/) { fail_usage ("-e must be followed by a command"); }
    if ($command) { fail_usage ("only one command may be specified"); }
    $command = $ARGV;
    shift @ARGV;
  } elsif ($ARGV eq '-d' ) {
    shift @ARGV;
    if (!($ARGV = $ARGV[0])) { fail_usage ("-d needs a filename"); }
    if ($ARGV =~ /^-/) { fail_usage ("-d must be followed by a filename"); }
    if ($datafile) { fail_usage ("only one data file may be specified"); }
    $datafile = $ARGV;
    shift @ARGV;
  } elsif ($ARGV eq '-t' ) {
    shift @ARGV;
    if (!($ARGV = $ARGV[0])) { fail_usage ("-t needs a filename"); }
    if ($ARGV =~ /^-/) { fail_usage ("-t must be followed by a filename"); }
    if ($template) { fail_usage ("only one template file may be specified"); }
    $template = $ARGV;
    shift @ARGV;
  } elsif ($ARGV eq '-p' ) {
    shift @ARGV;
    if (!($ARGV = $ARGV[0])) { fail_usage ("-p needs a pattern"); }
    if ($ARGV =~ /^-/) { fail_usage ("-p must be followed by a pattern"); }
    if ($pattern) { fail_usage ("only one pattern may be specified"); }
    $pattern = $ARGV;
    shift @ARGV;
  } elsif ($ARGV eq '-i' ) {
    shift @ARGV;
    if (!($ARGV = $ARGV[0])) { fail_usage ("-i needs a modifier string"); }
    if ($ARGV =~ /^-/)
      { fail_usage ("-i must be followed by a modifier string"); }
    if ($mod) { fail_usage ("only one modifier string may be specified"); }
    $mod = "i";
    shift @ARGV;
  } elsif ($ARGV eq '-c' ) {
    if ($comp) { fail_usage ("-c can only be specified once"); }
    $comp=1; shift @ARGV;
  }
  elsif ($ARGV eq '-nnn' ) { $debug+=3; shift @ARGV; }
  elsif ($ARGV eq '-nn' ) { $debug+=2; shift @ARGV; }
  elsif ($ARGV eq '-n' || $ARGV eq '--debug' ) { $debug++; shift @ARGV; }
  elsif ($ARGV eq '-v' || $ARGV eq '--verbose' ) { $verbose++; shift @ARGV; }
  elsif ($ARGV eq '-h' || $ARGV eq '--help') { fail_usage; }
  elsif ($ARGV =~ /^-/ ) { fail_usage " invalid option ($ARGV)"; }
  else                     { last ; }
}

if (scalar @ARGV) { fail_usage ("some options left over:", @ARGV); }
if (!$datafile)
  { fail_usage "no datafile supplied"; }
#if (!$template)
#  { fail_usage "no template supplied"; }
if (!$command)
  { fail_usage "no command supplied"; }

if ($template) {
  open TEMPLATE, "<$template" or die "Can't open file ($template)";
  @template = <TEMPLATE>;
  close TEMPLATE;
}

open DATAFILE, "<$datafile" or die "Can't open file ($datafile)";

@headers=split /[\t\n]/, <DATAFILE>;
for $i (0..$#headers) {
  $headers{$headers[$i]} = $i;
}

$err=0;
for $h (@headers) {
  if ($h =~ /[^a-z0-9_]/i) {
    ($h1 = $h) =~ s/[a-z0-9_]//ig;
    print STDERR "Error: header ($h) has illegal character(s) ";
    for $c (split //, $h1) { print STDERR "[$c]=(", ord($c), ") "; }
    print STDERR "\n";
    $err++;
  }
}

if ($err) { exit $err; }

if ($debug>3) {
  print "headers:\n";
  map {print " $_ "; } @headers;
  print "\n";
  while (($val, $var) = each %headers) {
    print "headers{$val}=($var)\n";
  }
}

while ($line=<DATAFILE>) {
  if ($pattern) {
    if ($mod) { $pat=qr/$pattern/i; } else { $pat=qr/$pattern/; }
    if ($comp) { if ($line =~ /$pat/) { next; } }
    else { if ($line !~ /$pat/) { next; } }
  }
  @line=split /[\t\n]/,$line;
  @thistemplate = @template;
  $thiscommand = $command;
  if ($#line < $#headers) { $line[$#headers] = ""; }
  map {
    if (/\$/) {
      s/\$([a-z_][a-z0-9_]*)|\$\{([a-z_][a-z0-9_]*)\}
       / if (defined($headers{$1})) { $line[$headers{$1}]; }
         else { $&; }
       /ixeg;
    }
  } ($thiscommand, @thistemplate);
  if (grep { /\$[a-z_]/i } ($thiscommand, @thistemplate)) {
    print STDERR "Warning: there are possible unsubstituted values\n";
    if ($thiscommand =~ /\$[a-z_]/i) {
      print STDERR " In the command ($thiscommand)\n";
      $t = $thiscommand;
      $t =~ s/^[^\$]*//;
      $t =~ s/(\$[a-z_][a-z_0-9]*)[^\$]*/$1 /gi;
      print STDERR "  These variables : $t\n";
    }
    @errn = (); $c=0;
    map { if (/\$[a-z_]/i) { push @errn, $c ;} $c++; } @thistemplate;
    if (scalar (@errn)) {
      print STDERR " In the template on these lines: \n";
      for $n (@errn) {
        $t = $thistemplate[$n];
        print STDERR " line[$n]:$t";
        chomp ($t);
        $t =~ s/^[^\$]*//;
        $t =~ s/(\$[a-z_][a-z_0-9]*)[^\$]*/$1 /gi;
        print STDERR "  These variables : $t\n";
      }
    }
    print STDERR "\n";
  }
  if ($debug) {
    if ($debug>2) { print "debug -----------\n"; }
    if ($debug>3) {
      print "values:\n";
      for $h (sort keys %headers) {
        print "\$$h=($line[$headers{$h}])\n";
      }
      print "debug -----------\n";
    }
    print "debug command ($thiscommand)\n";
    if ($debug>1) {
      map { print ; } @thistemplate;
    }
  } elsif (scalar (@template)) {
    if ($verbose) { print "command ($thiscommand)\n"; }
    if ( !open MAIL, "|$thiscommand") {
      print STDERR "Couldn't open command ($thiscommand)\n";
      next;
    }
    map { print MAIL; } @thistemplate;
    close MAIL
  } else {
    system "$thiscommand";
  }
}

close DATAFILE;