#!/usr/local/bin/perl -w
use strict;

use lib $ENV{LIBS};

use File::Basename;
use Getopt::Long;
use LogHandles;
use MIME::Lite;
use Text::Template;
use Utilities::Mail;

# A lot of thought was given whether to use MIME::Types here so that
# correct types and encodings could be inferred.  I decided that it's
# better to specify the exact parameters that I want, because this
# is a very delicate thing that we're doing to play nice with all
# the different email clients.

my %Extensions = (htm  => 'text/html',
                  html => 'text/html',
                  txt  => 'text/plain');
my $extension_regex = qr/\.(@{[join '|' => keys %Extensions]})\Z/o;

my %Encodings = ('text/html'  => 'quoted-printable',
                 'text/plain' => '7bit');

my %options;

unless (GetOptions(\%options, 'data=s', 'header=s', 'part=s@') &&
        defined($options{data})                                &&
        defined($options{header})                              &&
        defined($options{part})) {
    print STDERR "Required parameters:\n";
    print STDERR "--data   : name of a tab-delimited file with data, column headers in first line\n";
    print STDERR "           There must be a field named 'email'\n";
    print STDERR "--header : name of the RFC 822 header to be put on each email\n";
    print STDERR "--part   : various parts to be included in the email\n";
    exit(1);
}

open DATA, $options{data} or die "Cannot open $options{data} for input";
(my $columns = <DATA>) =~ s/\r?\n//;
unless ($columns =~ /(\A|\t)email(\t|\Z)/) { 
    print STDERR "At least one field in data must be exactly 'email'\n";
    exit(1);
}
my @columns = split /\t/, $columns;
my @data;
while (<DATA>) {
    s/\r?\n$//; # DOS chomp
    my %row;
    my @fields = split /\t/;
    if (@fields == @columns) {
        @row{@columns} = @fields;
        push @data, \%row;
    } else {
        $ERROR_LOG->print("Line $. of $options{data} has an incorrect number of fields, skipping");
    }
}
close DATA;

my $header_template = Text::Template->new(TYPE => 'FILE', SOURCE => $options{header},
                                          DELIMITERS => ['[@--', '--@]']);
unless (defined $header_template) {
    $SEVERE_LOG->print("Unable to initialize header template $options{header}: $Text::Template::ERROR");
    exit(1);
}

my %part_templates;
foreach (@{$options{part}}) {
    unless (-e $_ && -r && -f && /$extension_regex/) {
        $SEVERE_LOG->print("$_ is not a readable plain file of a known type, cannot be used");
        exit(1);
    }
    my $template = Text::Template->new(TYPE => 'FILE', SOURCE => $_,
                                       DELIMITERS => ['[@--', '--@]']);
    if (defined $template) {
        $part_templates{$_} = $template;
    } else {
        $SEVERE_LOG->print("Unable to initialize part template $_: $Text::Template::ERROR");
        exit(1);
    }
}

my %outcomes = (success => 0,
                fail    => 0);

OUTER:
for my $data (@data) {
    # Do something tricky here.  Fill in the header as necessary, then we'll split it up to add to
    # the message.
    defined (my $header = $header_template->fill_in(HASH => $data)) or do {
        $ERROR_LOG->print("Unable to fill in header template: $Text::Template::ERROR");
        $outcomes{fail}++;
        next;
    };
    my @header_parts = eval { map { split /:\s*/, $_, 2 } split /\n/, $header } or do {
        $ERROR_LOG->print("Header couldn't be parsed reasonably, skipping.");
        $ERROR_LOG->print($header);
        $outcomes{fail}++;
        next;
    };
    
    my $msg = MIME::Lite->new(@header_parts, Type => 'multipart/alternative');

    foreach my $path (@{$options{part}}) {
        $path =~ /$extension_regex/ and my $type = $Extensions{$1};
        my $template = $part_templates{$path};
        defined (my $part = $template->fill_in(HASH => $data)) or do {
            $ERROR_LOG->print("Unable to fill in part template $path: $Text::Template::ERROR");
            $outcomes{fail}++;
            next OUTER;
        };
        my @args = (Type => $type, Data => $part);
        push @args, Encoding => $Encodings{$type};
        $msg->attach(@args);
    }

    # Now mail it off
    Utilities::Mail::queue($data->{email}, $msg->as_string) && ++$outcomes{success} or ++$outcomes{fail};
}

$SUMMARY_LOG->print("Results of mailing:");
while (my ($outcome, $count) = each %outcomes) {
    $SUMMARY_LOG->printf("%-10s: %5d", ucfirst $outcome, $count);
}
$SUMMARY_LOG->printf('=' x 50);
$SUMMARY_LOG->printf("%-10s: %5d", 'Total', eval join '+' => values %outcomes);
