#!perl
##  Version 2.0.1    
##  Laurence R. Taylor  taylor.2@nd.edu www.nd.edu/~taylor
##  Copyright (C) 2000
##  Freely distributed under the standard GNU Copyleft agreement

use strict;
use Socket;
use Net::SMTP;
use File::Basename;

my($default_returnaddress, $default_addr_dir,$mysmtp,$APPL,%emails);

#######  BE SURE TO SET THESE VARIABLES TO CORRECT VALUES ##########
my(%mail_servers)=('XXXX'=>'XXXX');    # local_ip=>SMTP hash
my(@return_addresses)=('XXXX');        # return address(es)
$default_addr_dir='XXXX';              # my path to address files
$APPL='XXXX';                          # MacOS creator for saved files
####################################################################

if( -l $default_addr_dir) {$default_addr_dir=readlink($default_addr_dir);}
$default_returnaddress=$return_addresses[0];
my($packed_ip)=inet_aton("localhost");
my($ee);
if(length($packed_ip)!=4) {
  print"WARNING - Not connected to the internet!\n"; #error
  $mysmtp=$mail_servers{default};
  }
else { 
  $packed_ip=inet_ntoa($packed_ip);
  foreach $ee (keys(%mail_servers)) {
    if( $packed_ip=~m/^$ee/ ) {$mysmtp=$mail_servers{$ee};last;}
    }
  if($mysmtp eq "") {
    print $packed_ip," is an unlisted IP number. ";
    print "Be sure you have set the SMTP server using the Via: line";
    print "or a default SMTP server you know will work.\n"; #error
    $mysmtp=$mail_servers{default};
    }
  }
File::Basename::fileparse_set_fstype($^O); # set file routines to handle OS


my($do_not_send_flag,$save_as_name,$save_as_end,$array_or_hash);
my($st)="###########################";
$st.=$st;$st.=$st;$st.=$st;
 
my($NON_FILE_NAME_CHAR)="\xFF";

if($#ARGV < 0) {
  print"Need files/folders to accomplish anything!\n"; #error
  if($^O eq "MacOS") {
    print"Drop some files/folders onto the pmail droplet.\n";
    }
  else{
    print"Useage: pmail filename1 filename2 ...\n";
    }
  exit(1);
  }

my($message_file,@line,$err);

foreach $message_file (@ARGV) {
  if( -l $message_file ) {$message_file=readlink($message_file);}
  if(-f $message_file ) {
    $err=&handle_one_message_file($default_returnaddress,$message_file);
    if($err!=0) {caP("file",$message_file);} #error
    else {
      print sx(21),"\n";
      }
    }
  elsif( -d $message_file) {
    $err=&handle_one_dir($default_returnaddress,$message_file);
    if($err!=0) {caP("directory",$message_file);} #error
    }
}

exit();

sub handle_one_dir{
my($from_address,$dir)=@_;
my($err);my($ferr)=0;
chomp($dir);
if( opendir(DIR,$dir) ) {
  my(@files)=readdir(DIR);
  closedir(DIR);
  my($message_file);
  if( substr($dir,length($dir),1) ne":") {$dir.=":";}
  foreach $message_file (@files) {
    chomp($message_file);
    $message_file=$dir.$message_file;
    if( -l $message_file ) {$message_file=readlink($message_file);}
    if(-f $message_file ) {
      $err=&handle_one_message_file($default_returnaddress,$message_file);
      if($err!=0) {caP("file",$message_file);$ferr=1;} #error
      else { print sx(21),"\n";}
      }
    elsif( -d $message_file) {
      $err=&handle_one_dir($default_returnaddress,$message_file);
      if($err!=0) {caP("directory",$message_file);$ferr=1;} #error
      }
    else {print "Bad file \"",$message_file,"\".\n";$ferr=2;} #error
    }
  undef(@files);
  }
else {
  print"Failed to open directory \"",$dir,"\"\n";$ferr=3; #error
  }
return($ferr);
}

sub caP{
my($first,$me)=@_;
print "The ",$first," \"",$me,"\" caused the problem.\n";
}
#####  Handle each message file ##########

sub handle_one_message_file{
my($from_address,$file)=@_;
my(@lines);
undef(@lines);
undef(%emails);
my($stA)="Starting to process file \"".$file."\".";
my($eee);
print "\n",sx(length($stA)),"\n",sx(length($stA)),"\n",$stA,"\n";;
if( open(IN, $file) ) {
  @lines = ;
  close(IN);
  if($#lines<0) { print "The file contains no data.\n";return(1);} #error
  }
else {
  print "Woops - couldn't open \"$file\".\n"; #error 
  return(1);
  }

# initialize globals
$do_not_send_flag=0;$save_as_name="";$save_as_end="";$array_or_hash="";

my($subject,$type,$ii,$ToLine,$message_start,$comment);
my($smtp);
####  Clip to !END! and check for already sent
for($ii=0;$ii<=$#lines;$ii++) {
  if($lines[$ii]=~m/!END!/) {
    $ToLine=$`;
    last;
    }
  }
if( $ii<=$#lines) {$lines[$ii++]=$ToLine."\n";}
my($jj,$send_again);
my($sent_list)='#';
$send_again=0;
for($jj=$ii;$jj<=$#lines;$jj++) {
  if( $lines[$jj]=~m/^To:( .+\@.+)sent: /) {
    $send_again=1;$sent_list=$sent_list.$1.'#';
    $sent_list=~s/ +//g;
    }
  }
splice(@lines,$ii);
####  COLLECT THE To: LINE
if($lines[0]!~m/(Ag|To|XX|TT): */) {
  print "First line of email message must be a \"To: \" line.\n";return(1); #error
  }
$type=$1; 
if($send_again==1) {
  if($type eq "Ag" ) {$type="To";$sent_list='#';} 
  elsif($type eq "To") {
    print"This message has already been sent. Will only send to new addresses.\n"; #error
    }
  }
else{
  if($type eq "Ag" ) {
    print"This message has never been emailed so Ag: is not valid.\n"; #error
    $type="XX";
    }
  }
$ToLine=$';chomp($ToLine);$ToLine.=$NON_FILE_NAME_CHAR;
$comment=$`;$comment=~s/\*/\\*/g;
if($comment ne "") {
  for($ii=0;$ii<=$#lines;$ii++) {
    $lines[$ii]=~s/^$comment//;
    }
  }
$ii=1;
while($lines[$ii]!~m/Subject:/ && $ii<=$#lines && $lines[$ii]!~m/!END!/ ) {
  $ToLine.=$lines[$ii];
  chomp($ToLine);$ToLine.=$NON_FILE_NAME_CHAR;
  $ii++;}
if($lines[$ii]!~m/Subject:/) {
  print "Second line of email message must be the \"Subject:\" line.\n";return(2); #error
  }
else{
  $subject=$lines[$ii];
  $subject=~s/^.*Subject: *//;
  chomp($subject);
  }
## To: line and Subject: collected
## Collect From: and Via: lines
$ii++;
if(get_From_Via($lines[$ii],\$default_returnaddress,\@return_addresses,\$mysmtp,\%mail_servers)==0) {
  $ii++;
  if(get_From_Via($lines[$ii],\$default_returnaddress,\@return_addresses,\$mysmtp,\%mail_servers)==0) {
    $ii++;
    }
  }
$message_start=$ii;
if($ToLine=~m/\t/) {$ToLine=~s/\t/$NON_FILE_NAME_CHAR/g;}
else{$ToLine=~s/ /$NON_FILE_NAME_CHAR/g;}
$ToLine=~s/$NON_FILE_NAME_CHAR+/$NON_FILE_NAME_CHAR/g;
## Replace the delineator with $NON_FILE_NAME_CHAR

# Now check for CC or BCC
while($lines[$ii]!~m/^(BC|C)C:/ && $ii<=$#lines && $lines[$ii]!~m/!END!/ ) {$ii++;}
my($CCType,$CCLine);
$CCType="";
$CCLine="";
if($ii<=$#lines) {
  if($lines[$ii]=~m/^(CC|BCC):/){$CCType=$1;$CCLine=$';chomp($CCLine);$CCLine.="$NON_FILE_NAME_CHAR";
    $ii++;
    while($lines[$ii] ne "" &&  $ii<=$#lines && $lines[$ii]!~m/!END!/ ) {
      $CCLine.=$lines[$ii];chomp($CCLine);$CCLine.="$NON_FILE_NAME_CHAR";
      $ii++;
      }
  }
  if($CCLine=~m/\t/) {$CCLine=~s/\t/$NON_FILE_NAME_CHAR/g;}
  else{$CCLine=~s/ /$NON_FILE_NAME_CHAR/g;}
  $CCLine=~s/$NON_FILE_NAME_CHAR+/$NON_FILE_NAME_CHAR/g;
  }
# Collect CC:-line and replace delineator with $NON_FILE_NAME_CHAR
my(%CCs,$err,@CCs,$a_or_h);
# get data off the To:-line
$err=Mail_Line_Assemble($ToLine,\%emails,$file,0,$sent_list,\$a_or_h);
if($err!=0) {
  print"Error occurred with the main address.\n"; #error
  return($err);
  }
if($CCLine ne "") {
  $err=Mail_Line_Assemble($CCLine,\@CCs,$file,1,0,0);
  if($err!=0) {
    print"Error occurred with the CC's. Here is the data I am trying to resolve.\n"; #error
    print"..",$CCLine,"..\n";
    return($err);
    }
  }
my(@message,$perl_code,$exclamations);
$perl_code=$exclamations=0;
for($ii=$message_start;$ii<=$#lines;$ii++) {
  if($lines[$ii]=~m/^(!END!$|CC:|BCC:)/) {last;}
  push(@message,$lines[$ii]);
  if($lines[$ii]=~m/!\[\d+\]!/) {
    if($a_or_h eq "a") {$exclamations=1;} else {$exclamations-=10;;last;}
    }
  if($lines[$ii]=~m/!\{.+\}!/) {
        if($a_or_h eq "h") {$exclamations=2;} else {$exclamations-=20;last;}
        }
  if($lines[$ii]=~m/\[\[\[/) {$perl_code=1;}
  }
if($exclamations<0) {
  if($exclamations=>-8) {
    if($a_or_h=~m/(A|H)/) {
      print"Collecting email addresses broke down, but you have substitutions.\n";
      }
    else {
      print"You have collected by array but your replacements are by hash.\n";
      }
    }
  elsif($exclamations=>-18) {
    if($a_or_h=~m/(A|H)/) {
      print"Collecting email addresses broke down, but you have substitutions.\n";
      }
    else {
      print"You have collected by hash but your replacements are by array.\n";
      }
    }

  return($exclamations);
  }
my($haveEND)=0;
for($ii=$message_start;$ii<=$#lines;$ii++) {
  if($lines[$ii]=~m/^!END!$/) {$haveEND=1;last;}
  }
undef(@lines);

my($ee,$yy,$zz,$ss,$tmpmessage,@tmpmessage);
my($blank,$firstblank,$ll,$tt);

###  MAILER LOOP ######
my($send_flag,$add_flag,$message_counter,$OK);
$add_flag=0;$message_counter=0;
foreach $ee (sort(keys(%emails))){
  $send_flag=$type;$message_counter++;
  @tmpmessage=@message;
  ## Do the !! substitutions
  if($exclamations==1) {
    for($zz=0;$zz<=$#tmpmessage;$zz++) {
      while($tmpmessage[$zz]=~m/!\[(\d+?)\]!/) {
        $ss=$1;
        if($ss<0) {$ss+=$#{$emails{$ee}}+1;}
        if($ss>$#{$emails{$ee}} || $ss<0) {
          print"The substitution ![",$ss,"]! is out of range [0-"; #error
          print$#{$emails{$ee}},"] data items.\n";
          if($type eq "To" || $type eq "Ag") {return(10);}
          }
        elsif(${$emails{$ee}}[$ss] eq "") {
          print"WARNING: substitution ![",$ss,"]! is empty in message to ",$ee,"\n"; #error
          }
        $tmpmessage[$zz]=~s/!\[$ss\]!/${$emails{$ee}}[$ss]/g;
        }
      }
    }
  elsif($exclamations==2) {
    for($zz=0;$zz<=$#tmpmessage;$zz++) {
      while($tmpmessage[$zz]=~m/!\{(.+?)\}!/) {
        $ss=$1;
        print$ee,"------\n";
        print$emails{$ee},"------\n";
        if( ! exists(${$emails{$ee}}{$ss}) ) {
          print"The key for the subsitution !{",$ss,"}! is undefined.\n"; #error
          if($type eq "To" || $type eq "Ag") {return(10);}
          }
        elsif(${$emails{$ee}}{$ss} eq "") {
          print"WARNING: substitution !{",$ss,"}! is empty in message to ",$ee,"\n"; #error
          }
        $tmpmessage[$zz]=~s/!\{$ss\}!/${$emails{$ee}}{$ss}/g;
        }
      }
    }
  ## do the code evaluations
  $tmpmessage=join('',@tmpmessage);
  if($perl_code==1) {
    if($tmpmessage=~m/\[\[\[/) {
      $err=do_the_perl_code(\$tmpmessage,\%emails,$ee,$file,$exclamations);
      if($err!=0) {
        print"Perl code evaluation failed for the message to ",$ee,"\n"; #error
        return($err);
        }
      if($do_not_send_flag==1 || $do_not_send_flag==2 ) {
        $send_flag="DNS";
        }
      }
    }
  ## add CC's if needed
  if($CCType eq "CC") {
    $tmpmessage.="CC:";$blank="    ";
    $firstblank=" ";
    foreach $tt (@CCs) {
      $tmpmessage.=$firstblank.$tt."\n";
      $firstblank=$blank;
      }
    }
  if($send_flag eq "To" || $send_flag eq "XX" || $send_flag eq "TT" ) {
    if($message_counter==1) {print"Sending\n\nTo:  ";} else {print"To:  ";}
    $OK=send_a_message_to($ee,$from_address,$subject,\$tmpmessage,\$file,\$haveEND,"",$CCType,$send_flag);
    if($OK!=0) {return($OK);}
    if($CCType ne "") {
      my($printLine);
      if($CCType eq "CC" ) {$blank="     ";$printLine="CC:  ";}
      else {$blank="     ";$printLine="BCC: ";}
      $firstblank=" ";
        foreach $tt (@CCs) {
        print$printLine;
        $OK=send_a_message_to($tt,$from_address,$subject,\$tmpmessage,\$file,\$haveEND,$CCType,$firstblank,$send_flag);
        $firstblank=$blank;
        }
      }
    if($send_flag eq "To") {$add_flag=1;}else{$add_flag=0;}
    print"##\n";
    }
  elsif($send_flag eq "DNS") {
    if($do_not_send_flag==1) {
      print"Your Perl code has requested that the message not be sent to \"",$ee,"\".\n"; #error
      print"##\n";
      }
    }    
  undef(@tmpmessage);
  }
print "using mail server ",$mysmtp," and return address ",$default_returnaddress,".\n";
print"Finished\n",sx(14),"\n\n";
if($add_flag==1) {
  open(ADD,">>$file") or die("Died trying to write \"".$file."\" to add final ***.\n"); #error
  print ADD "*****************************\n";
  close(ADD);
  }
undef(%emails);
undef(@lines);
return(0);
}

sub Mail_Line_Assemble{
my($string,$email_record,$message_file,$CC,$sent_list,$a_or_h)=@_;
my(@mails,$err,$ii,$jj,%sanity,$filter,$file);
@mails=split($NON_FILE_NAME_CHAR,$string);
if($string=~m/.+\@.+/) {
  for($ii=0;$ii<=$#mails;$ii++) {
    if($mails[$ii] eq "") {next;}
    if($mails[$ii]!~m/.+\@.+/) {
      print "\nAt least one field looks like an email address, but not all of them do.\n";#error
      print "\"",$mails[$ii],"\" is the first non-email field.\n";
      for($jj=0;$jj<=$#mails;$jj++) {
        if($mails[$jj]=~m/.+\@.+/) {
          print"\"",$mails[$jj],"\" is the first email field.\n"; #error
          }
        }
      return(3);
      }
    if($CC==0) {
      if($sent_list!~m/$mails[$ii]/i) {
        ${$email_record}{$mails[$ii]}[0]=$mails[$ii];
        }
      }
    else {
      push(@$email_record,$mails[$ii]);
      }
    }
  if($a_or_h!=0) {$$a_or_h="a";}
  }
else { #each @mails is a file name of a file merge or a filter
  ## at the moment we do not support files with lists of files!
  $filter="";
  #initialize sanity check
  $sanity{max}=0;$sanity{address_column}="";$sanity{a_or_h}="";$sanity{hashes}="";
  $err=0;
  for($ii=0;$ii<=$#mails;$ii++) {
    if( $mails[$ii] eq "" ) {next;} #skip any blank file names that have crept in
    if($mails[$ii]=~m/~m\/(.+)\/$/) {$filter=$1;next;} ## Get a ~m/.../ $filter
    elsif($mails[$ii]=~m/^\[(.+)\{(.+)\}=>\{(.+)\}\]$/) { ## append data
      if($CC==1) {
        print"CC/BCC lists do not support appending data.\n",$mails[$ii];
        print" is the offending statement.\n";
        next;
        }
      $file=get_file($1,$message_file);
      $err=Append_data_to_email_record($file,$2,$3,$email_record,\%sanity);
      }
    else{ ## add addresses
      $file=get_file($mails[$ii],$message_file);
      $err=Add_addresses_to_email_record($file,$email_record,\%sanity,$filter,$CC,$sent_list);
      }
    if($err!=0) {
      print"File \"",$mails[$ii],"\" was the cause of the problem.\n"; #error
      return($err);
      }
    }
  }
if( $CC==0 && keys(%$email_record) <1) {print"There are no email addresses.\n";}#error
elsif( $CC==1 && $#$email_record <0 ) {print"There are no CC/BCC addresses.\n";}#error
if($a_or_h!=0) {$$a_or_h=$sanity{a_or_h};}
undef(%sanity);
return(0);
}

sub get_file{
my($file,$message_file)=@_;
my($dir)=`pwd`;chomp($dir);
my(@fname)=File::Basename::fileparse($message_file);
my($tfile)=$fname[0];if($fname[2] ne "") {$tfile.=".".$fname[2];}
my($message_dir)=$fname[1];
$file=~s/^ +//;$file=~s/ +$//; # stip leading and trailing spaces
if( $tfile ne $file && -f $message_dir.$file) {
    $file=$message_dir.$file;
    }
  else {
    $file=$default_addr_dir.$file;
    }
return($file);
}

sub Add_addresses_to_email_record{
my($file,$email_record,$sanity,$filter,$CC,$sent_list)=@_;
my(@data,@line,$max,@hash_array,$data_start);
my($address_column,$delineator,$err);
if( open(IN,$file) ) {
  @data=;
  close(IN);
  }
else{print"Unable to open file \"",$file,"\".\n"; return(999);}
$err=&get_switch_data(\$array_or_hash,\$delineator,\$address_column,
    \$max,\@hash_array,\$data_start,\@data);
if($err!=0) {return(1000+$err);}
if($CC==0) {
  $err=sanity_check($sanity,$max,$array_or_hash,$address_column,\@hash_array);
  if($err!=0) {return($err);}
  $array_or_hash=${$sanity}{a_or_h};
  ##  DO NOT RESET $address_column=${$sanity}{address_column};;
  $max=${$sanity}{max};
  @hash_array=@{${$sanity}{hashes}};
  }
my($ii,$uu);
for($ii=$data_start;$ii<=$#data;$ii++) {
  chomp($data[$ii]);
  if($data[$ii] eq "") {next;}       ## Blank lines in address file are skipped.
  if( $filter ne "" && $data[$ii]!~m/$filter/) {next;} ## Filter addresses.
  @line=split($delineator,$data[$ii]);
  if($line[$address_column]!~m/.+\@.+/) {
    print"\"",$line[$address_column],"\" does not look like an email address to me.\n"; #error
    return(2);
    }
  if( $CC==0 && $sent_list=~m/$line[$address_column]/i) {
    print"Already sent to ",$line[$address_column],"\n";
    next;
    } ## Filter addresses.
  while($#line<$max) {push(@line,"");}

  if($array_or_hash eq "a" ) {
    if($CC==0) {${$email_record}{$line[$address_column]}=[@line];}
    else{
      push(@$email_record,$line[$address_column]);
      }
    }
  elsif($array_or_hash eq "A" ) { ## Problem with sanity check, just collecting by array[0]
    my($rr);
    foreach $rr (keys(%{$email_record})) {
      undef(@{${$email_record}{$rr}});
      ${${$email_record}{$rr}}[0]=$rr;
      }
    ${$email_record}{$line[$address_column]}=[$line[$address_column]];
    }
  elsif($array_or_hash eq "H" ) {## Problem with sanity check, just collecting by hash
    ${${$email_record}{$line[$address_column]}}{$hash_array[0]}=$line[$address_column];
    }
  elsif($array_or_hash eq "h" ) {
    if($CC==0) {
      for($uu=0;$uu<=$#hash_array;$uu++) {
        ${${$email_record}{$line[$address_column]}}{$hash_array[$uu]}=$line[$uu];
        }
      }
    else{
      push(@$email_record,$line[$address_column]);
      }
    }
  undef(@line);
  }
undef(@data);
return(0);
}

sub Clean_Key{
my($key)=shift(@_);
$key=~s/^ +//;$key=~s/ +$//;
$key=~s/ +,/,/g;$key=~s/, +/,/g;
return($key);
}

sub get_start_and_delineator{
my($data,$start_data,$local_delineator)=@_;
if($$data[0]=~m/\#!address/) {
  $$start_data=2;
  if( $$data[0]=~m/-d\'(.+?)\'/) {
    $$local_delineator=$1;
    if($$local_delineator eq "	") {$$local_delineator='\t';} ## there's a TAB there
    }
  } 
else{$$start_data=1;}
if($$local_delineator eq "") {
  if($$data[$$start_data-1]=~m/\t/){$$local_delineator='\t';}
  elsif($$data[$$start_data-1]=~m/ /){$$local_delineator=' ';}
  elsif($$data[$$start_data-1]=~m/:/){$$local_delineator=':';}
  else{$$local_delineator=0xFF;} ## no local_delineator found - use unlikely vlaue.
  }
}
sub Append_data_to_email_record{
my($file,$keyA,$keyB,$email_record,$sanity)=@_;
my(@data);
if( open(IN,$file) ) {
  @data=;
  close(IN);
  }
else{print"Unable to open file \"",$file,"\".\n"; return(998);}
## Cleanup keys
$keyA=Clean_Key($keyA);if($keyA eq "") {return(997);}#error
$keyB=Clean_Key($keyB);if($keyA eq "") {return(996);}#error
if( ${$sanity}{a_or_h} ne "h") {
  print"Can not append because we are not collecting by hash - ",${$sanity}{a_or_h},"\n"; #error
  return(400);
  }
my(%append,$ii,$uu,@line,$key,$local_delineator,@hash_fields,@number_hash,$start_data);
## get delineator and fields
get_start_and_delineator(\@data,\$start_data,\$local_delineator);
@hash_fields=split($local_delineator,$data[$start_data-1]);
chomp(@hash_fields);
my(%moose,@hashA,$kk);
@hashA=split(",",$keyB);chomp(@hashA);
for($uu=0;$uu<=$#hashA;$uu++) {
  for($kk=0;$kk<=@hash_fields;$kk++) {
    if( $hashA[$uu] eq $hash_fields[$kk]) {
      $number_hash[$uu]=$kk;
      }
    }
  }
## collect data with $keyB hash
for($ii=$start_data;$ii<=$#data;$ii++) {
  @line=split($local_delineator,$data[$ii]);chomp(@line);
  $key="";
  for($uu=0;$uu<=$#number_hash;$uu++) {
    $key.="#".$line[$number_hash[$uu]];
    }
  for($uu=0;$uu<=$#line;$uu++) {
    ${$append{$key}}{$hash_fields[$uu]}=$line[$uu];
    }
  }
## append data",
# put $keyA into array
@hashA=split(",",$keyA);;chomp(@hashA);
foreach $ii (keys(%{$email_record})) {
  %moose=%{${$email_record}{$ii}};
  $key="";
  for($uu=0;$uu<=$#hashA;$uu++){
    $key.="#".$moose{$hashA[$uu]};
    }
  foreach $kk (sort(keys(%{$append{$key}}))){
    ${${$email_record}{$ii}}{$kk}=${$append{$key}}{$kk};
    }
  }
@hashA=split(",",$keyB);;chomp(@hashA);
my($uuu);
for($uu=0;$uu<=$#hashA;$uu++){
  $uuu=join("\t",@{${$sanity}{hashes}});
  if($uuu!~m/$hashA[$uu]/) {
    push(@{${$sanity}{hashes}},$hashA[$uu]);
    }
  }
undef(@data);
undef(%append);
undef(%moose);
undef(@hashA);

return(0);
}

sub sanity_check{
my($sanity,$max,$array_or_hash,$address_column,$hashes)=@_;
my($ii);
if(${$sanity}{a_or_h} eq "") {
  ${$sanity}{max}=$max;${$sanity}{address_column}=$address_column;
  ${$sanity}{a_or_h}=$array_or_hash;${$sanity}{hashes}=$hashes;
  return(0);
  }
else{
  if(${$sanity}{a_or_h} ne $array_or_hash) {
    print"Sanity check error; ",${$sanity}{a_or_h}," ne ",$array_or_hash,"\n"; #error
    ## Collect address by ${$sanity}{a_or_h} only. Reset $max, $hash_array
    if(${$sanity}{a_or_h} eq "a") {
      print"Just collecting email addresses by array.\n";#error
      ${$sanity}{a_or_h}="A";
      }
    elsif(${$sanity}{a_or_h} eq "h") {
      print"Just collecting email addresses by hash.\n"; #error
      ${$sanity}{a_or_h}="H";
      }
    ${$sanity}{max}=0;
    return(0);
    }
  if($array_or_hash eq "a") {
    if(${$sanity}{max} ne $max) { ## Wrong number of entries
      print"Sanity check error: ",${$sanity}{max}," ne ",$max,"\n"; #error
      print"Just collecting email addresses by array.\n"; #error 
      ${$sanity}{hashes}=0;
      ${$sanity}{max}=0;
      ${$sanity}{a_or_h}="A";
      return(0);}
    if(${$sanity}{address_column} ne $address_column) { ## Wrong address column
      print"Sanity check error: ",${$sanity}{address_column}," ne ",$address_column,"\n"; #error
      print"Just collecting email addresses by array.\n";#error
      ${$sanity}{hashes}=0;
      ${$sanity}{max}=0;
      ${$sanity}{a_or_h}="A";
      return(0);
      }
    else{return(0);}
    }
  else {
    if(${${$sanity}{hashes}}[${$sanity}{address_column}] ne ${$hashes}[$address_column]) {
      print"Sanity check error: ",${${$sanity}{hashes}}[${$sanity}{address_column}]; #error
      print" ne ",${$hashes}[$address_column],"\n"; #error
      print"Just collecting email addresses by hash.\n"; #error
      my($tmp)=${${$sanity}{hashes}}[${$sanity}{address_column}];
      undef(@{${$sanity}{hashes}});
      ${${$sanity}{hashes}}[0]=$tmp;
      ${$sanity}{address_column}=0;
      ${$sanity}{max}=0;
      ${$sanity}{a_or_h}="H";
      return(0);
      }
    my($hashx)=join("\0xFF",@$hashes);$hashx="\0xFF".$hashx."\0xFF";
    for($ii=0;$ii<=$#{${$sanity}{hashes}};$ii++) {
      if($hashx!~m/\0xFF${${$sanity}{hashes}}[$ii]\0xFF/) {
         print"Sanity check error: ",${${$sanity}{hashes}}[$ii],
              " is not a hash in the most recent file.\n"; #error
        ## Drop this field from ${$sanity}{hashes}}
        splice(@{${$sanity}{hashes}},$ii,1);
        return(0);
        }
      }
    return(0);
    }
  }
return(100);
}

my(@fields,%fields);

sub do_the_perl_code {
my($mess,$emails,$send_address,$file,$aoh)=@_;
my($start,$end,$middle,$startc,$endc,$middleA);
if($aoh==2 ) {
  %fields=%{${$emails}{$send_address}};
  }
else {
  @fields=@{${$emails}{$send_address}};
  }
$startc=0;
undef($save_as_name);
while( ($startc=index($$mess,"\[\[\[",$startc))>=0) {
  $endc=index($$mess,"\]\]\]",$startc+3);
  if( $endc>$startc) {
    $start=substr($$mess,0,$startc);
    $end=substr($$mess,$endc+3);
    $middleA=substr($$mess,$startc+3,$endc-$startc-3);
    $middle="\0";
    $middleA='$middle=\'\';'.$middleA;
    $do_not_send_flag=0;
    $middle=eval $middleA;
    if( $@ ne '' || $middle eq "\0" ) {
      chomp($@);
      print"Perl code evaluation failed: start of error message\n$@\nEnd of error message.\n";#error
      return(2);
      }
    else {
      if($do_not_send_flag==1 || $do_not_send_flag==2 ) {return(0);}
      $$mess=$start.$middle.$end;
      $startc=length($start)+length($middle);
      }
    }
  else {
    $middle=substr($mess,$startc);
    print"Failed to find closing \]\]\]\n$middle"; #error
    return(3);
    }
  }
return(0);
}


sub send_a_message_to{
my($ee,$from_address,$subject,$tmpmessage,$file,$haveEND,$CCtype,$CCblank,$ToLine)=@_;
my($smtp);
my($OK);
if( $ToLine eq "To") {
  $OK=1;
  if($mysmtp ne "") {
    $OK=mail_it($mysmtp,$ee,$from_address,$subject,$tmpmessage);
    }
  else{ 
    print"\nThe SMTP server address is empty.\n"; #error
    }
  if($OK==1) {return(1);}
## if we want to save it as another file do that here!
  if($save_as_name ne "") {
    my(@dname)=File::Basename::fileparse($$file);
    my($dir)=$dname[1];
    $$file=$dir.$save_as_name;
    open(OUT,">$$file") or die("Died trying to save the message as ",$$file,".\n"); #error
    print OUT "To: ",$ee,"\n";
    print OUT "Subject: ",$subject,"\n";
    print OUT $$tmpmessage;
    if($save_as_end ne "") {
      print OUT "\n!END!\n";
      $$haveEND=1;
      print OUT $save_as_end;
      }
    close(OUT);
    if($^O eq "MacOS") {MacPerl::SetFileInfo($APPL,'TEXT',$$file);}
    $save_as_name="";$save_as_end="";
    }
    ### append !END!
    if(open(ADD,">>$$file") ) {
      my(@times)=localtime();
      if($$haveEND==0) {
        print ADD "\n!END!\n";
        $$haveEND=1;
        }
      if($CCtype eq "") {
        Info_Line("\nTo:  ",$ee,\@times,\*ADD);
      #  printf ADD ("\nTo:  %-40s sent: %02u/%02u/%04u at %02u:%02u:%02u\n",$ee,
      #      $times[4]+1,$times[3],$times[5]+1900,$times[2],$times[1],$times[0]);
        print ADD "using mail server ",$mysmtp," and return address ",$default_returnaddress,".\n";
        }
      else{
        if($CCblank eq " ") {
          Info_Line($CCtype.":".substr("   ",0,4-length($CCtype)),$ee,\@times,\*ADD);
          }
        else {Info_Line($CCblank,$ee,\@times,\*ADD);}
      #  if($CCblank eq " ") {
      #    print ADD $CCtype,":",substr("   ",0,4-length($CCtype));
     #     }
      #  else {
      #    print ADD $CCblank;
      #    }
      #  printf ADD ("%-40s sent: %02u/%02u/%04u at %02u:%02u:%02u\n",$ee,
      #      $times[4]+1,$times[3],$times[5]+1900,$times[2],$times[1],$times[0]);
        }
      close(ADD);
      }
    else {
      print("\nUnable to write \"".$$file."\" to add !END! or time stamp.\n"); #error
      print("This often means the file is open.\n\n"); #error
      }
  }
elsif($ToLine eq "XX") {
 if(open(ADD,">>$$file") ) {
   close(ADD);
    }
  else {
    print("\nWould have been unable to write \"".$$file."\" to add !END! or time stamp.\n");#error
    print("This often means the file is open.\n\n");#error
    }
  if($CCtype eq ""){
    print$ee,"\n";
    print"Subject: ",$subject,"\n";
    print$$tmpmessage;
    if($CCblank eq "" ) {print"#### end of message ####\n\n";}
    else {print"      ## end of message ##\n\n";}
    if($save_as_name ne "") {
      print"Would have saved the message as \"",$save_as_name,"\".\n";
      $save_as_name="";
      }
    }
  else{
    print$ee,"\n";
    }
  }
elsif($ToLine eq "TT") {
  print "$ee\n";
  }
return(0);
}

sub Info_Line{
my($first,$ee,$times,$fh)=@_;
printf $fh ("%-5s%-40s sent: %02u/%02u/%04u at %02u:%02u:%02u\n",$first,$ee,
            $$times[4]+1,$$times[3],$$times[5]+1900,$$times[2],$$times[1],$$times[0]);
}

sub mail_it{
my($mysmtp,$ee,$from_address,$subject,$tmpmessage)=@_;
##print "LOCKED $ee\n";return(0); ## LOCK OUT MAILING DURING TESTING!
$subject="Subject:".$subject."\n";
my($smtp) = Net::SMTP->new($mysmtp);
if(!$smtp) {print "\nSMTP startup failed for $mysmtp\n";return(1);}
print "$ee\n"; # print the current email address
$smtp->mail($from_address);
$ee=~s/<\w+>//;$ee=~s/ +//g;
$smtp->to($ee);
$smtp->data();
$smtp->datasend($subject);
$smtp->datasend($$tmpmessage);
$smtp->dataend();
$smtp->quit();
sleep(5);
return(0);
}


sub get_switch_data{
my($array_or_hash,$delineator,$address_column,$max,$hash_array,$data_start,$data)=@_;
# GET SWITCH DATA FOR THIS ARRAY OF $data
#   $array_or_hash can be 'a' or 'h'
#   OR 'A' or 'H' which means collect just email address by array or hash

# read shebang line
if($$data[0]!~m/#!address/) {
  print"Line 1 of an address file needs to begin\n";
  print"Line 1='#!address ...'\n";
  chomp($$data[0]);
  print"Line 1='",$$data[0],"'\n";
  print"is what you actually have on line 1.\n";
  return(1);
  }
## get switches -x -d -t and -a
$$address_column=0;$$delineator='';

if( $$data[0]=~m/-x\'(\d\d\/\d\d\/\d\d\d\d)\'/) {
  ## check expiration date
  my(@lt)=split(/\//,$1);
  my(@time)=localtime();
  $time[5]+=1900-$lt[2];
  $time[4]+=1-$lt[0];
  if( ($time[5]>0) || 
      ($time[5]==0 && $time[4]>0) ||
      ($time[5]==0 && $time[4]==0 && $time[3]>$lt[1]) ) {
    print"File expired on $1.\n";
    return(1);
    }
  undef(@time);undef(@lt);
  }

get_start_and_delineator($data,$data_start,$delineator); ## $data_start is not right

if( $$data[0]=~m/-t\'(h|H|a|A)\'/) {
  $$array_or_hash=lc($1);
  if($$array_or_hash eq "a") {$$data_start=1;}
  else {$$data_start=2;}
  }
else{
  if($$data[1]=~m/\@/) {
    $$array_or_hash="a";
    $$data_start=1;
    }
  else {
    $$array_or_hash="h";
    $$data_start=2;
    }
  }
my($uu,@line);
if($$data_start==2) {
  @$hash_array=split($$delineator,$$data[1]);
  chomp(@$hash_array);
  }

if( $$data[0]=~m/-a\'(.+?)\'/) {
  $$address_column=$1;
  }
else{
  @line=split($$delineator,$$data[$$data_start]);
  for($$address_column=0;$$address_column<=$#line;$$address_column++) {
    if($line[$$address_column]=~m/.+\@.+/) {last;}
    }
  }
$$max=0;my($ii);
for($ii=$$data_start;$ii<=$#$data;$ii++) {
  @line=split($$delineator,$$data[$ii]);
  if($$max<$#line) {$$max=$#line;}
  undef(@line);
  }
if($$address_column>$$max) {
  print"Can find no column with email addresses.\n";
  return(4);
  }
if($$address_column<0) {$$address_column=$$max+$$address_column+1;}
return(0);
}

sub get_From_Via{
my($line,$default_returnaddress,$return_addresses,$mysmtp,$mail_servers)=@_;
my(@tmp,$eee);
if($line=~m/^(From|Via):/) {
  chomp($line);
  @tmp=split(':',$line);
  $tmp[1]=~s/^ +//;
  if($line=~m/^From:/) {
    if(length($tmp[1])<3) {
      $$default_returnaddress=$$return_addresses[$tmp[1]];
      }
    else {
      $$default_returnaddress=$tmp[1];
      for($eee=0;$eee<=$#$return_addresses;$eee++) {
        if($$return_addresses[$eee]=~m/$tmp[1]/) {
          $$default_returnaddress=$$return_addresses[$eee];last;
          }
        }
      }
    }
  else {
    $$mysmtp=$tmp[1];
    foreach $eee (keys(%$mail_servers)) {
      if($$mail_servers{$eee}=~m/$tmp[1]/) {
        $$mysmtp=$$mail_servers{$eee};last;
        }
      }
    }
  return(0);
  }
else{return(1);}
}


sub sx{
my($m)=shift(@_);
return(substr($st,0,$m));
}

## can be used by Perl code in messages.
sub do_not_send {
$do_not_send_flag=1;
}
sub Do_not_send {
$do_not_send_flag=2;
}

sub quote{
  my($ss,$data)=@_;
  chomp($data);
  $data=~s/\n/\n$ss/gi;
  return($ss.$data."\n");
}

sub save_as{ 
($save_as_name,$save_as_end)=@_;
}

####### END #############