#!/usr/local/bin/perl

#
# dbformmail
# Copyright (C) 1997-1998 by John Heidemann <johnh@isi.edu>
# $Id: dbformmail,v 1.14 2003/05/23 04:17:15 johnh Exp $
#
# This program is distributed under terms of the GNU general
# public license, version 2.  See the file COPYING
# in $dblibdir for details.
#
sub usage {
    print <<REALEND;
usage: $0 [-ds] form

Read a ``form mail'' message from a file,
filling in underscore-preeded column-names with data.
Produces a shell script which will send each message through sendmail.

Do not use this program for evil or I will have to come over
and have words with you.

Options:
    -s write a script to send the mail (the default)
    -S send the mail directly (not currently supported)
    -m MECHANISM   select the mail-sending mechanism (Mail [default]
		    or sendmail)
    -d debugging mode

Sample input:
#h account passwd uid gid fullname homedir shell
johnh * 2274 134 John_Heidemann /home/johnh /bin/bash
greg * 2275 134 Greg_Johnson /home/greg /bin/bash
root * 0 0 Root /root /bin/bash
# this is a simple database

Sample form (in the file form.txt):
    To: _account
    From: the sysadmin <root>
    Subject: time to change your password

    Please change your password regularly.


Sample command:
cat DATA/passwd.jdb | dbformmail form.txt

Sample output:
#!/bin/sh
sendmail 'johnh' <<'END'
To: johnh
From: the sysadmin <root>
Subject: time to change your password

Please change your password regularly.

END
sendmail 'greg' <<'END'
(etc.)

REALEND
    #';   hack for font-lock mode
    exit 1;
}

BEGIN {
    $dblibdir = "/home/johnh/BIN/DB";
    push(@INC, $dblibdir);
}
require "$dblibdir/dblib.pl";
use DbGetopt;

my(@orig_argv) = @ARGV;
my($prog) = &progname;
my($write_script) = 1;
my($debug) = 0;
my($mechanism) = 'Mail';
my($dbopts) = new DbGetopt("dm:s?", \@ARGV);
my($ch);
while ($dbopts->getopt) {
    $ch = $dbopts->opt;
    if ($ch eq 's') {
	$write_script = 1;
    } elsif ($ch eq 'd') {
	$debug++;
    } elsif ($ch eq 'm') {
	$mechanism = $dbopts->optarg;
    } else {
	&usage;
    };
};
&usage if ($#ARGV != 0);
if (!($mechanism eq 'Mail' || $mechanism eq 'sendmail')) {
    warn "$0: unknown mail mechanism $mechanism.\n";
    &usage;
};
my($form_file) = $ARGV[0];
die ("$prog: non- -s verison not currently implemented.\n") if (!$write_script);

#
# Read the form.
#
open(FORM, "<$form_file") || die("$prog: cannot open $form_file.\n");
@form = ();
while (<FORM>) {
    s/\@/\\\@/;   # quote @'s
    push(@form, $_);
}
close FORM;
die ("$prog: no To: line in form.\n")
    if (!grep(/^To:/i, @form));


#
# Do it.
#
&readprocess_header;
# Generate the code.
my($code) = codify("<<END;\n" . join("", @form) . "END\n");

print $code if ($debug);

print "#!/bin/sh\n";

while (<STDIN>) {
    if (&is_comment) {
	push(@comments, $_);
	next;
    };
    &split_cols;
    $result = eval $code;   $@ && die ("$prog: internal eval error ``$@''.\n");

    # This is not a very elegant to extract the destination.  :-<
    my(@field_names) = qw(to cc subject);
    my($field_regexp) = '(' . join("|", @field_names) . ')';
    my(%fields);
    my($in_body) = undef;
    my $result_body = '';
    foreach (split(/\n/, $result)) {
	if ($in_body) {
	    $result_body .= "$_\n";
	    next;
	};
	if (/^\s*$/) {
	    # blank line terminates header
	    $in_body = 1;
	    next;  
	};
	if (/^$field_regexp:\s*(.*)$/i) {
	    my($key, $value) = (lc($1), $2);
	    die "$0: duplicate fields not supported, field: $key.\n"
		if (defined($fields{$key}));
	    $fields{$key} = $value;
	};
    };
    die ("$prog: to missing.\n") if (!defined($fields{'to'}));

    # Quote single quotes in $to.
    foreach (keys %fields) {
	$fields{$_} =~ s/\'/\'\\\'\'/g;
    };

    if ($mechanism eq 'sendmail') {
        print "sendmail '" . $fields{"to"} . "' <<'END'\n$result\nEND\n\n";
    } elsif ($mechanism eq 'Mail') {
	my $cc_arg = (defined($fields{"cc"}) ? "-c '" . $fields{"cc"} . "' " : "");
	my $subject_arg = (defined($fields{"subject"}) ? "-s '" . $fields{"subject"} . "' " : "");
	print "Mail $subject_arg $cc_arg '" . $fields{"to"} . "' <<'END'\n$result_body\nEND\n\n";
    } else {
	die "$0: unknown mechanism $mechanism.\n";
    };
};

print "\n" . join("", @comments) . "# | $prog " . join(" ", @orig_argv) . "\n";
exit 0;