#!/usr/local/bin/perl -w

use strict;
require "getopts.pl";

# mailmerge - basic mail merge utility
#
# Copyright (C) 2002-2005 John J. Chew, III
#
# $Id: mailmerge,v 1.6 2006/03/20 16:57:44 jjc Exp jjc $
#
# $Log: mailmerge,v $
# Revision 1.6  2006/03/20 16:57:44  jjc
# documentation fix
#
# Revision 1.5  2006/03/18 15:36:41  jjc
# + more documentation
#
# Revision 1.4  2006/03/18 15:33:50  jjc
# + documentation
#
# Revision 1.3  2006/03/18 15:30:10  jjc
# + Support for mail headers at top of template
# + check for no recipients matching -u
#
# Revision 1.2  2005/05/19 14:27:18  jjc
# + documentation
# + Net::SMTP support
#
# Revision 1.1  2005/04/14 18:47:34  jjc
# Initial revision
#

=head1 NAME

B<mailmerge> - make merged mail messages from a template and send using SMTP

=head1 SYNOPSIS

B<mailmerge> [-c config-file] [-p pattern] [-u] names-file ['subject'] message-file

=head1 DESCRIPTION

B<mailmerge> expands numerical macro references in a template message file
according to information found in a data names file, then sends the
resulting individualized messages to the corresponding addresses.

C<names-file> is a text file, each of whose lines consists of an 
e-mail address followed by any number of tab-separated values.
The first value will replace any occurrence of the string C<$1>
in the message file, etc.

C<'subject'>, if given, gives the C<Subject:> line to be used when
sending all messages.  If not given, then the message file will be
checked for an initial C<Subject:> line.

C<message-file> is a text file containing a template of the message
to be sent.  In addition to the abovementioned C<Subject:> line,
the following optional mail headers are recognized: 
C<Content-Type:>, C<MIME-Version:>.
Macros of the form C<$number> will be expanded up to the
largest-numbered datum in the current line of the names file.  C<$$>
will always expand to a C<$>.

=over 4

=item B<-c> config-file

If specified, overrides the default search locations for a configuration
file, which are first B<$ENV{'HOME'}/.mailmergerc> and second 
B<mmcfg.txt>.  See below for the format of the configuration file.

=item B<-p> pattern

If specified, only those names file lines which match the given
regexp will be used.

=item B<-u>

This flag is used together with the B<-p> flag to specify that only
one names file line should be used.  If more than one line matches
the B<-p> pattern, an error message will be displayed and no mail
will be sent.
This is useful when you want to resend a message to just one user
in your list, or when you want to test a merge by sending it just
to yourself.

=back

=cut

sub Initialise ();
sub Main ();
sub SendOne ($$$@);
sub SendUsingExternal ($$$);
sub SendUsingModule ($$$);
sub Usage ();

Main;

=head1 CONFIGURATION

B<mailmerge> searches for a configuration file at the location
specified by B<-c>, at B<$ENV{'HOME'}/.mailmergerc> and at
B<mmcfg.txt> in that order.  If it finds one, it tries to execute
it as a Perl script, and aborts if it fails.  A configuration file
should start with the line B<package config;>, end with the line
B<1;> and in between have any of the following lines.

=over 4

=item B<$auth = ["username", "password"];>

If you are using B<$smtp = "Net::SMTP"> you may specify an SASL
username and password, if you server expects them.

=item B<$debug = 1;>

If you add this line, you will see a verbose trace of attempted
SMTP connections using B<Net::SMTP>.

=item B<$from = 'you@your.domain';>

You must specify a return address for your mail.  Use single quotes,
because if you use double quotes Perl thinks the C<@> is special.

=item B<$mailhost = "host.domain";>

If you are using B<$smtp = "Net::SMTP"> you must specify the SMTP
server which will relay your mail.

=item B<$smtp = "method";>

Specifies how you want to try sending the mail.  Allowed values for
B<method> are B<Net::SMTP> to use that Perl library (which usually
accompanies a standard Perl installation) or something like 
B</usr/lib/sendmail> which specifies the location of an external
program that handles your mail.

=item B<$subject = "string";>

If you're always using the same subject, you can store it in your
configuration file, which will override the command line and the
contents of your message files.

=back

Here's a sample configuration file:

  package config;
  $from = 'me@my.dom.ain';
  $mailhost = 'smtp';
  $smtp = 'Net::SMTP';

=cut

=head1 TROUBLESHOOTING

Always send yourself a test message to make sure your macros expand
as expected.

If your message includes the C<$> sign, say for discussing dollar amounts,
always double it (C<$$>) to prevent it from being interpreted as a macro.

If you are sending mail using B<Net::SMTP> and it is disappearing into
the either, try enabling B<$debug> in your configuration file.

=cut

sub Initialise () {
  $^W = 0;
  &Getopts('c:p:u-:') || Usage;
  $^W = 1;
  Usage unless $#ARGV == 1 || $#ARGV == 2;
  $config'names_fn = shift @ARGV;
  $config'message_fn = pop @ARGV;
  $config'subject = @ARGV ? shift @ARGV : '';
  $config'mailhost = undef;
  $config'smtp = 'Net::SMTP'; # or '/usr/lib/sendmail';
  if ($::opt_c) {
    $config'config_fn = $::opt_c;
    }
  elsif ($ENV{'HOME'} && -r "$ENV{'HOME'}/.mailmergerc") {
    $config'config_fn = "$ENV{'HOME'}/.mailmergerc";
    }
  elsif (-r "mmcfg.txt") {
    $config'config_fn = "mmcfg.txt";
    }
  if ($config'config_fn) {
    unless (my $result = do $config'config_fn) {
      if ($!) { die "Can't read $config'config_fn: $!\n"; }
      elsif ($@) { die "Can't compile $config'config_fn: $!\n"; }
      else { die "$config'config_fn did not return a true value: $!\n"; }
      }
    }
  if ($config'smtp =~ /^net::smtp$/i) {
    require Net::SMTP;
    }
  }

sub Main () {
  Initialise;
  my $template = '';

  open(MESSAGE, "<$config'message_fn") or die "Can't open message file: $!\n";
  {
    local($/) = undef;
    $template = <MESSAGE>;
    while ($template =~ s/^([-\w]+):\s*(.*)\n+//) {
      my $key = $1;
      my $value = $2;
      if ('subject' eq lc $key) { $config'subject = $value; }
      elsif ($key =~ /^(?:content-type|mime-version)$/i) {
	push(@config'headers, "$key: $value");
        }
      else {
	die "Unsupported header: $key\nAborting";
        }
      }
  }
  close(MESSAGE);

  open(NAMES, "<$config'names_fn") or die "Can't open names file: $!\n";
  if ($::opt_p) {
    my @matched;
    while (<NAMES>) { chomp;
      next unless /$::opt_p/o;
      push(@matched, [split(/\t/)]);
      }
    close(NAMES);
    if ($::opt_u) {
      die "More than one matching address line.\n" if @matched > 1;
      die "No matching lines.\n" if @matched == 0;
      }
    for my $line (@matched) {
      my ($address, @fields) = (@$line);
      SendOne $template, $config'subject, $address, @fields;
      sleep(1) unless $::opt_u;
      }
    }
  else {
    while (<NAMES>) { chomp;
      my ($address, @fields) = split(/\t/);
      SendOne $template, $config'subject, $address, @fields;
      sleep(1);
      }
    close(NAMES);
    }
  }

sub SendOne ($$$@) {
  my $message = shift;
  my $subject = shift;
  my $address = $_[0];

  my $pattern = '\$\$';
  my (%replace) = ('$$' => '$');
  for (my $i = $#_; $i>0; $i--) {
    $pattern .= "|\\\$$i";
    $replace{'$' . $i} = $_[$i];
    }
# die $pattern;
  for my $s ($message, $subject) {
    $s =~ s/$pattern/$replace{$&}/g;
    }
  if ($config'smtp =~ /^Net::SMTP$/i) {
    SendUsingModule $message, $subject, $address;
    }
  else {
    SendUsingExternal $message, $subject, $address;
    }
  }

sub SendUsingExternal ($$$) {
  my $message = shift;
  my $subject = shift;
  my $address = shift;

  my $from = $config'from 
    or die "Please specify a return address in your configuration file.\n";

  my $pid = open(MAIL, "|-");
  if ($pid) { 
    print MAIL <<"EOF";
From: $from
Subject: $subject
To: $address
EOF
    print MAIL $message;
    close(MAIL) || warn "$pid exited $?\n";
    }
  else {
    print "Sending mail to $address.\n";
    exec($config'smtp, '-f', '$from', $address)
#     exec('/usr/bin/mail', '-s', $subject, $address)
      || die "exec $config'smtp failed: $!";
    }
  }

sub SendUsingModule ($$$) {
  my $message = shift;
  my $subject = shift;
  my $address = shift;

  my $from = $config'from 
    or die "Please specify a return address in your configuration file.\n";
  my $mailhost = $config'mailhost 
    or die "Please specify an SMTP server in your configuration file.\n";

  print "Sending mail to $address.\n";
  my $smtp = Net::SMTP->new($mailhost);
  $smtp->debug($config'debug) if $config'debug;
  if ($config'auth) {
    $smtp->auth(@$config'auth);
    }
  $smtp->mail($from);
  $smtp->to($address);
  $smtp->data();
  $smtp->datasend("From: $from\n");
  $smtp->datasend("To: $address\n");
  $smtp->datasend("Subject: $subject\n");
  for my $header (@config::headers) {
    $smtp->datasend("$header\n");
    }
  $smtp->datasend("\n");
  for my $line (split(/\n/, $message, -1)) {
    $smtp->datasend("$line\n");
    }
  $smtp->dataend();
  $smtp->quit;
  }

sub Usage () {
  die "Usage: $0 [-c config-file] [-p pattern] [-u] names-file ['subject'] message-file\n"
    . "  -c config-file specify a configuration file\n"
    . "  -p pattern     select only lines in names-file matching pattern\n"
    . "  -u             abort if more than one line matched\n";
  }

=head1 AUTHOR

John J. Chew, III <jjchew@math.utoronto.ca> http://www.poslfit.com

=cut