#!/usr/bin/perl -w

# Usage: pr.rel2.pl <txtmsg> <email-addresses> <attempts-list> <delay #>
#        and it expects a file called smtppwd.txt in a location specified
#        below. The <delay> between msgs is in seconds, and the delay used is
#        100-200% of that delay, averaging 150% of the seconds value.
# Example:  pr.rel2.pl pr.rel2.txtmsg pr.rel2.do apr.rel2.done 18
#
# David Harris, Version of 14 Jan 2006 pm 05:50
# [Autoflushes ATTEMPTS buffer, so one can see what the last email
#  was, after some kinds of crash]

#  [Delays 2 seconds before AUTH authentication is 
#  sent, in hope of giving possibly ansynchronous processes enough
#  time to complete before the authentication process begins.]

# ------------------------------------------------

use Net::SMTP;
use Authen::SASL qw(Perl);


# Read SMTP servername|account|passwd|delay|debugFlag from an outside file that
# can be changed to use different outgoing SMTP systems, perhaps on different
# friends' machines.  The file name and location can be customized here:
open(SMTPPWD, 'C:/htdocs/smtppwd.txt') or die "Couldn't open smtppwd.txt";
chomp($lineread = <SMTPPWD>);     # Reads just first line.
close(SMTPPWD);
# Breaks into 5 substrings at |'s:
($servername, $smtpusername, $passwd, $debugFlag)
        = split /\|/, $lineread, 4;
# 0 for $debugFlag sets NO debugging.

# Check the number of arguments on the command line:
if ($#ARGV+1 != 4) {
  die "pr.rel2.pl needs txtmsg file, emails file, successes file,
  and delayseconds, as arguments";
  };
  
# Check existence of the textfile and email listing file:
(open TXTMSG, "<$ARGV[0]") or die "pr.rel2.pl textmsg file not found.\n";
(open EMAILS, "<$ARGV[1]") or die "pr.rel2.pl emails file not found.\n";
# And file to report successful sendings:
(open ATTEMPTS, ">$ARGV[2]") or die "pr.rel2.pl: successes/out file not opened.\n";
# And delay-time base number (up to 100% of it will be randomly added to it):
# Thus a value of 48 sec. will average 50 msg/hour, 8 => 8 to 16 sec, averaging
#  12 sec, etc.  Changes to use of the delay and the random aspect
#   are "hard coded" in this program.
$delayseconds = "$ARGV[3]";

#Read the internal documentation from the TXTMSG template file, and throw
# the internal documentation away:
THRUDOCS: while ($lineread = <TXTMSG>) {
  last THRUDOCS if ($lineread =~ /^----------------------+$/);
}

# Read in the lines that give the substitution target fields,
# like TTTTT=1 and FFFFF=2 etc. (which tell which strings are targets to
# be substituted in the text message farther down in the TXTMSG file)
# followed by an '=' sign and the number of the field (column) to
# substitute from each line of the EMAILS file.

# IF there isn't at least one line of such substitutions, then there will
# not be any variation in the emails sent to, so don't use this program but
# just send an ordinary email to a single (set of) persons.

$linenum = 0;
while ($lineread = <TXTMSG>) {
  chomp $lineread;
  if ($lineread =~ /\w+=\d+/) {
     ($substit[$linenum], $subsfield[$linenum]) = split /=/, $lineread, 2;
     $linenum++;
  } elsif ($lineread =~ /^M+$/) {
     last;
  }
    else { die "MMMMMM...MMMMM line not found.\n";}
}

$msglines = 0;
# Read in the substitutable lines from the textfile opened above:
while ($lineread = <TXTMSG>) {
# The mail stuff wraps the lines if needed.
$messagearray[$msglines] = $lineread;
$msglines++;    # The array grows and this index is used below.
};
close(TXTMSG);

$emailnumber = 1;  # Counter of emails sent, for output near end
# Do the rest of this program once for each non-empty line in EMAILS file
while ((chomp($email = <EMAILS>)) && (length($email) > 2)) {
  # Put fields into array.
  @fields = split /\|/, $email;

  # Now @messagearray has the text with the targets embedded,
  #     @substit has the images of the targets,
  #     @subsfield has the numbers of the fields that are  used, and
  #     @fields has the fields OF THIS PARTICULAR EMAIL FILE LINE
  #        to put in place of the targets.

  # Exception handler starts with eval around the block that might
  # throw an exeption:  [REMOVED!!]
  # Activate the SMTP link: [IMPLEMENTING A RETRY ABILITY]
  $numretries = 0;
  RETRY: for ($retries = $numretries; $retries >= 0; $retries--) {
  # Make the 'Date:' string for this particular email
  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
                  localtime(time-(0*3600)-3);  # Future time zone correction?
  $weekday = (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$wday];
  $monthname = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$mon];
  $yr2000 = $year+1900;
  if (length($mday) == 1) {
    $mday = '0'.$mday;
  }
  if (length($hour) == 1) {
    $hour = '0'.$hour;
  }
  if (length($min) == 1) {
    $min = '0'.$min;
  }
  if (length($sec) == 1) {
    $sec = '0'.$sec;
  }
  $datestr = "$weekday, $mday $monthname $yr2000 $hour\:$min\:$sec +0000\n";
  $hadwarning = 0;  # Set problem flag to "No problemo" before trying to send.
      # $servername comes from smtppwd.txt file here.:
      if ($debugFlag eq '0') {
        $smtp = Net::SMTP->new( Host => $servername,
                                Hello => 'darwinday.sbcglobal.net',
                                Timeout => 120 );
      } else {
        $smtp = Net::SMTP->new( Host => $servername,
                                Hello => 'darwinday.sbcglobal.net',
                                Timeout => 120,
                                Debug => 1 );     # Non-zero says DO debugging.
      }
      sleep 6;  # Does this give enough time to avoid the "auth error"
                #   problems?
      $smtp->auth($smtpusername,$passwd);  # Authentication!
      #Start of substitutable message, as stored in array by code above
      for ($j = 0; $j
           < $msglines; $j++) {  # Step thru array of stored lines
        $linetosend = $messagearray[$j];
        for ($i = 0; $i < $linenum; $i++) {  #For this line, make substitutions
          # Make a substitution as often as needed in 1 line:
          ($linetosend = $linetosend) =~ s/$substit[$i]/$fields[$subsfield[$i]-1]/g;
        }
        # Special calls for the first 3 lines:
        SWITCH: {
          if ($j == 0) { eval'$smtp->mail($linetosend)';
                        if ($@) {warn("WARNING: $@\n"); $hadwarning = 1 };
              last SWITCH;
          }
          if ($j == 1) { eval'$smtp->recipient($linetosend)';
                        if ($@) {warn("WARNING: $@\n"); $hadwarning = 1 };
              last SWITCH;
          }
          # Blank line then the computed date:
          if ($j == 2) { eval'$smtp->data()';
                        if ($@) {warn("WARNING: $@\n"); $hadwarning = 1 };
              last SWITCH;
          }
          # All further lines:

          if ($linetosend =~ m/^From: /) {
            $smtp->datasend("Date: $datestr");  # Emit computed date
          }
          chomp($linetosend);  # Lines must end with CR/LF!
          eval '$smtp->datasend($linetosend."\r\n")';
                if ($@) {warn("WARNING: $@\n"); $hadwarning = 1 };
          #print STDERR "DOLLAR-AT VALUE IS $@\n"; 
        } # End of SWITCH.
      }
      $smtp->dataend();
      $smtp->quit;
      # Write the emails.txt line that was attempted to be sent, and its number:
      chomp($dateinsert = $datestr);
      # Cause ATTEMPTSs log to flush after every char write
      #                (from p.781 of Programming Perl, v.3):
      my $oldfilehandle = select ATTEMPTS; $| = 1 ; select $oldfilehandle;
      if ($hadwarning == 1) {
        print ATTEMPTS  "$dateinsert HADWARNING |$emailnumber|$email\n" ;
        print STDERR "At $dateinsert HADWARNING #$emailnumber: $email\n" ;        
      } else {
        print ATTEMPTS  "$dateinsert processed|$emailnumber|$email\n" ;
        print STDERR "At $dateinsert processed #$emailnumber: $email\n" ;
        $emailnumber++ ;  # Only increment on successes
      }
      # Let some seconds elapse: the specified time plus randomly to 100% more:
      sleep $delayseconds + int(rand ($delayseconds * 100/100)) ;
    } # End of RETRY: FOR loop.
  }  # End of processing one line of email addresses (one person).
print STDERR "ATTEMPTS file closed and about to exit now.\n" ;
exit;