#!/dcs/bin/perl
# The previous line needs to be changed to the path for your system's perl.

# zd.pl 1.01
# Copyright (c) 1994,1995 Regents of the University of California
# This code may be distributed and used freely as long as the above copyright
# notice is kept intact.
   
# Written by Leonard Megliola III
# January 13, 1995

# This version includes e-mail address chopping and alias file searching.
# This version also includes case-insensitivity of all Zot-Dispatch variables.

# There are no guaranties/warranties about the performance of this program. Any
# errors discovered should be e-mailed to Leonard Megliola (lmegliol@uci.edu)

# Revisions:
#    11/14/97: Fixed one known incompatibility with the Perl5 binary.

#############################################################
# Almost everything that needs to be configured follows:
# (The first line of the program needs to be configured too.)
#############################################################

$date = "/usr/bin/date";      # Just check the paths of these two programs.  
$mailer = "/dcs/bin/mhmail";  # 

$Chop_Address = 0;   # If this variable is set to 1, then all e-mail addresses
		     # will have everything after the "@" removed (including
		     # the "@", and only one e-mail address can be entered
		     # in each individual input variable.  If more than one
		     # e-mail address is desired, enter them into additional
		     # input variables of the same name.  If more than one
		     # e-mail address is entered in one input variable only
		     # the first will be used.  This makes it impossible to 
		     # e-mail outside of the server machine.

$Alias_File = "";    
		     # This variable must either be the empty string or contain
		     # the name of an alias file readable by the server.  If a
		     # file is named here, then zot-dispatch will look up each
		     # alias in the file.  If the alias is present, it will
		     # be substituted by the e-mail address, if not, the alias
		     # will remain as the address being sent to.  Normal alias
		     # files MIGHT not work with zot-dispatch.  The alias file
		     # should have on each line an alias immediately followed
		     # by a colon, followed by the e-mail address.
		     # $Chop_Address must be set to 1 for this to work.

$Separator = "\;";   # Character(s) that separate fields in method variable
                     # Be careful when changing this.  Test to make sure
                     # your separator works if you change it.

# Define where the library can be found (What directory.)

$cgilib = "/Web/doc/indiv/lmegliol/www/cgi-bin";

push(@INC,$cgilib);
require 'cgi-lib.pl';   # Change "cgi-lib.pl" to whatever you named it if you
                        # changed its name.

#############################################################
# Everything that needs to be configured is above.
#############################################################

# These variables define the Zot-Dispatch variables that are used in the HTML
# form.  

$ZDV_Method = "zd-method";
$REFLECT = "zd-reflect";
$MAIL = "zd-mail";
$APPEND = "zd-append";
$ZOT_ENVARS = "zd-environment";
$ZD_DATE_FORMAT = "zd-date-format";
$ZD_DATE = "zd-date";
$DATE_ELEMENT = "ZD-Date";
$ZD_Owner = "zd-owner";
$DEFAULT_SUBJECT = "Results from Zot-Dispatch";

# Constants defined for identifying states
$BODY = 1;
$FILE = 0;

# Global variable
$ERRORS = "";
$REFLECT_STORAGE = "";
$ZOT_SUBJECT = "";

# The following associative array is used as a table to look up variable names
# to see if they are Zot-Dispatch variables or not.

%elements = ($ZDV_Method,'',$REFLECT,'',$MAIL,'',$APPEND,'',$ZOT_ENVARS,'',
		$ZD_DATE_FORMAT,'',$ZD_DATE,'',$ZD_Owner,'');

# Create the initial table of name/value pairs from data retrieved
# either from the STDIN or the command line.

&ReadParse;  
print &PrintHeader;    # Print the content-type

# Take every variable returned, convert it to lower case, check to see if
# is a Zot-Dispatch variable, if so, keep it lower case and insert it into
# a new associative array containing the name value pairs.  If it isn't a 
# Zot-Dispatch variable, then put the variable name into the second associative 
# array as it is found in the first.

foreach $key (keys %in) { 
	$key_orig = $key;
        ($temp_key = $key) =~ tr/A-Z/a-z/;
        $key = $temp_key if (defined($elements{$temp_key}));
	$temp{$key} .= '\0' if (defined($temp{$key}));
	$temp{$key} .= $in{$key_orig};
}
%in2 = %temp;

# First, if a date format variable is present, then insert the
# date (with the specified format) into our table so that
# it can be substituted into a body.  If the format is empty
# then the format of the date will be the default for that program

if (defined $in2{$ZD_DATE_FORMAT}) {
	@DATE_ARRAY = split(/\\0/,$in2{$ZD_DATE_FORMAT});
	$DATE_FORMAT = $DATE_ARRAY[$#DATE_ARRAY];
	if ($DATE_FORMAT eq "") {
		chop ($in{$DATE_ELEMENT} = `$date`);
		$in2{$ZD_DATE} = $in{$DATE_ELEMENT};
	} else {
		chop ($in{$DATE_ELEMENT} = `$date +\"$DATE_FORMAT\"`);
		$in2{$ZD_DATE} = $in{$DATE_ELEMENT};
	}
}

# For each environment variable named in ZOT_ENVARS put the
# environment variable's name and that variable's value into the
# table.

if (defined $in2{$ZOT_ENVARS}) {
	@envars = split(/\\0/,$in2{$ZOT_ENVARS});
	foreach $var (@envars) {
		$in{$var} = $ENV{$var} if (!defined($in{$var}));
		$in2{$var} = $in{$var} if (!defined($in2{$var}));
	}
} 

# Global variables that contain the two default responses.
$RDEFAULT = &Build_Reflect_Default;
$DEFAULT = &Build_Default;

# If there are multiple methods, they will all be stored in the same
# variable separated by \0.  (See ReadParse subroutine in cgilib.pl)
# Here I split the list into the separate methods........

@METHOD = split(/\\0/,$in2{$ZDV_Method});
foreach $METHOD (@METHOD) {
	($DISPATCH_METHOD,$DESTINATION,$FORMAT) = split(/$Separator/,$METHOD,3);

	$DISPATCH_METHOD =~ tr/A-Z/a-z/;

	$DISPATCH_COPY = $DISPATCH_METHOD;
	$DESTINATION_COPY = $DESTINATION;
	$FORMAT_COPY = $FORMAT;

	# Substitute the value of the variables if any of the method 
	# fields were defined indirectly.  (Substitute the variable name
	# with the value of the variable, and take only the last value
	# of the variable if it is Method or Template and has
	# more than one variable.........

	if ($DISPATCH_COPY =~ /\s*\$(.*)#\s*/) {
		$DISPATCH_METHOD = $in{$1} if (defined $in{$1});
	        @DM = split(/\\0/,$in{$1});
		$DISPATCH_METHOD = $DM[$#DM] if ($#DM > 0);
	}

	if ($DESTINATION_COPY =~ /\s*\$(.*)#\s*/) {
		$DESTINATION = $in{$1} if (defined $in{$1});
	}

	if ($FORMAT_COPY =~ /^\s*\$(.*)#\s*/) {
		$FORMAT = $in{$1} if (defined $in{$1});
		@F = split(/\\0/,$in{$1});
		$FORMAT = $F[$#F] if ($#F > 0);
	}

	# Check to see if the template is a file, body, or default and then
	# call Substitute_Into_Template() to do the substitution......

	$_ = $FORMAT;
	if ($_ =~ /^\s*file:(.*)\s*/i) {
		$DATA = &Substitute_Into_Template($FILE,$1);
		$RDATA = $DATA;
	} elsif ($_ =~ /^\s*body:(.*)\s*/i) {

		$FORMAT =~ s/body:/body:/i;

		#Had to do the following because Perl has a hard
		#time recognizing multi-line expressions.

		$temp_body = substr($FORMAT,index($FORMAT,"body:")+5);
		$DATA = &Substitute_Into_Template($BODY,$temp_body);
		$RDATA = $DATA;
	} else {
		$RDATA = $RDEFAULT;
		$DATA = $DEFAULT;
	}

	# Below, depending on what the method is, Call the subroutine that
	# does it.  One problem though.  I want to make it so that only
	# the last method of type reflect is executed.  It would be more
	# simple to have the first execute, but possibly better for the last.
	# This is what I did.  For every method of type reflect, append the
	# data that would have been reflected to a variable separated from the
	# other reflect data by "\0".  After we have finished going through
	# all the methods, take the last reflect data in the variable and output
	# that.

	if ($DISPATCH_METHOD eq $REFLECT) {
		$REFLECT_STORAGE .= $RDATA . "\\0";
	} elsif ($DISPATCH_METHOD eq $MAIL) {
		&Mail_Response($DATA,$DESTINATION);
	} elsif ($DISPATCH_METHOD eq $APPEND) {
		&Append_Response($DATA,$DESTINATION);
	}
}

# We haven't performed our reflect yet, so take off the last data in our
# Reflect storage variable and return in.

@REFLECTS = split(/\\0/,$REFLECT_STORAGE);
&Reflect_Response($REFLECTS[$#REFLECTS]);

# Mail off any errors that occurred to the address in ZD-Owner if it is
# defined.

if ($ERRORS ne "") {
	&Mail_Errors($DEFAULT) if (defined $in2{$ZD_Owner});
}

############################################
# End of Main Program   Subroutines Follow #
############################################

sub Reflect_Response {
	local($RDATA) = @_;
	print($RDATA);
}

sub Mail_Response {

	local($DATA,$To) = @_;

	$Addresses = "";
	
	# If there was more than one variable with the same name that had
	# addresses in it, then there are some addresses separated by \0.
	# Split them up and separate them by spaces.

	foreach $value (split(/\\0/,$To)) {
		if ($Chop_Address == 1) {
			$value =~ s/@.*/ /g;
			if ($Alias_File ne "") {
				$value =~ /\s*([a-zA-Z0-9_\-]*)\s*/;
				$value = &search($1);
			}
		}
		$Addresses .= ", " . $value;
	}

	$Addresses =~ s/'//g;

	# If subject line is empty, make subject default.
	$ZOT_SUBJECT = $DEFAULT_SUBJECT if ($ZOT_SUBJECT eq "");

	if (!open(MAIL, "| $mailer '$Addresses' -subject \"$ZOT_SUBJECT\"")) {
	    $ERRORS .= "Mailer $mailer could not be successfully opened.\n";
        }
	
	print(MAIL "\r\n");
	print(MAIL $DATA);
	print(MAIL "\n\n");
	if (!close(MAIL)) {
		$ERRORS .= "Mailer $mailer reported completing unsuccessfully";
		$ERRORS .= "to: " . $Addresses . "\n";
	}
}

sub Append_Response {

	local($DATA,$FILENAME) = @_;

	# If there was more than one variable with the same name that contained
	# filenames, then split up the filenames and apend to each file.

	@FILENAMES = split(/\\0/,$FILENAME);
	foreach $FILE (@FILENAMES) {
		if (-w $FILE) {
			if (open(HANDLE,">> $FILE")) {
				print(HANDLE $DATA);
				if (!close HANDLE) {
					$ERRORS .= "Closing file $FILE returned error code.\n";
				}
			} else {
				$ERRORS .= "File $FILE could not be opened.\n";
			}
		} else {
			$ERRORS .= "File $FILE could not be written to.\n";
		}
	}
}

sub Mail_Errors {

	local($DATA) = @_;

	# This subroutine is almost exactly like the first mail subroutine except
	# it sends out the errors and the name/value pairs.  There is also no
	# error messages generated when something goes wrong.  Think about it.

	$Addresses = "";
	foreach $value (split(/\\0/,$in2{$ZD_Owner})) {
		if ($Chop_Address == 1) {
			$value =~ s/@.*/ /g;
                        if ($Alias_File ne "") {
                                $value =~ /\s*([a-zA-Z0-9_\-]*)\s*/;
                                $value = &search($1);
                        }
		}
		$Addresses .= ", " . $value;
	}
	
	$Addresses =~ s/'//g;

	open(MAIL, "| $mailer '$Addresses' -subject \"Errors in Zot-Dispatch\"");
	
	print(MAIL "\r\n");
	print(MAIL "The following errors occurred when running Zot-Dispatch:\n\n");
	print(MAIL $ERRORS);
	print(MAIL "\n*******************************************************\n\n");
	print(MAIL $DATA);
	print(MAIL "\n\n");

	close(MAIL);
}

sub Build_Default {

	# Builds up the default name/value pairs in plain text.

    $DEFAULT = "Submittal Results\n";
    $DEFAULT .= "The following name/value pairs were submitted:\n\n";
    foreach (keys %in) {
        @VALUES = split(/\\0/,$in{$_});
		$DEFAULT .= "<LI><CODE>$_ = </CODE>\n" if (($n = @VALUES) == 0);
        foreach $VALUE (@VALUES) {
            $DEFAULT .= "$_ = $VALUE\n";
        }
    }
    $DEFAULT;
}

sub Build_Reflect_Default {

	# Builds up the name value pairs in HTML

    $RDEFAULT = "<!DOCTYPE HTML PUBLIC \"-//W3O//DTD W3 HTML 2.0//EN\">\n\n";
    $RDEFAULT .= "<HTML>\n<HEAD>\n<TITLE>Submittal Results</TITLE>\n</HEAD>\n";
    $RDEFAULT .= "<BODY>\n<H1>Submittal Results</H1>\n";
    $RDEFAULT .= "The following name/value pairs were submitted:\n";
    $RDEFAULT .= "<UL>\n";
    foreach (keys %in) {
        @VALUES = split(/\\0/,$in{$_});
		$RDEFAULT .= "<LI><CODE>$_ = </CODE>\n" if (($n = @VALUES) == 0); 
        foreach $VALUE (@VALUES) {
            $RDEFAULT .= "<LI><CODE>$_ = $VALUE </CODE>\n";
        }
    }
    $RDEFAULT .= "</UL>\n\n</BODY>\n</HTML>\n";
    $RDEFAULT;
}


sub Substitute_Into_Template {

	# This subroutine goes through some text looking for the pattern
	# "$name#"  Where name is the name of an index in Zot-Dispatch's 
	# associative array.  If the variable is present, replace the "$name#"
	# with the value of the variable, otherwise just replace it with 
	# the name of the variable (essentially removing the $ and #).  Also
	# looks for "$$".  If found it replaces "$$" with just one literal dollar
	# sign.  This gives people a way to enter dollar signs into their text

	local($TYPE,$FILENAME) = @_;
	$ZOT_SUBJECT = "";

	# $TYPE contains a value declaring whether the body is presently in the 
	# $FILENAME variable or whether $FILENAME contains a filename 
	# of a file to open and get the body.

	if ($TYPE == $FILE) {
		$ZOT_BODY = "";
		if (open(ZOTFILE,$FILENAME)) {
			$_ = <ZOTFILE>;            #This part checks the first line of the
			if (/\s*Subject:(.*)/i) {  #file to see if it has "Subject:xxxxxx"
				$ZOT_SUBJECT = $1;     #If so, that line is removed and the
			} else {                   #subject of a mail (if mail is sent) is
				$ZOT_BODY = $_;        #xxxxxx.  Otherwise, nothing is changed.
			}
			$ZOT_BODY .= $_ while (<ZOTFILE>);
		} else {
			$ERRORS .= "File $FILENAME could not be opened to get template.\n";
		}
	} else {
		$_ = $FILENAME;
		if (/^\s*Subject:(.*)/i) {
			$ZOT_SUBJECT = $1;
			s/^.*\n//;
			$FILENAME = $_;
		}
		$ZOT_BODY = $FILENAME;
	}

	# Begin substitution
	# We will read this character by character.  When we hit a $ we check
	# to see if the next character is also a dollar sign.  If so replace
	# both with one.  If the character following the first dollar sign is
	# not a dollar sign also, then read in the characters until you reach
	# a pound sign.  Then you have the variable name. If the variable
	# is in the associative array, then replace it with it's value, otherwise
	# replace it with it's name.

	$length = length($ZOT_BODY);
	$index = -1;
	while ($index < $length) {
		$index++;
		$char = substr($ZOT_BODY,$index,1);
		if ($char eq "\$") {
			$first = $index;
			$index++;
			$char = substr($ZOT_BODY,$index,1);
			if ($char eq "\$") {
				substr($ZOT_BODY,$first,2) = "\$";
				$index = $index - 1;
				$length = $length -1;
				next;
			}
			$string = "";
			while ($char ne "\#") {
				$string .= $char;
				$index++;
				$char = substr($ZOT_BODY,$index,1);
			}
			$last = $index;

			$temp_string = $string;
			$temp_string =~ tr/A-Z/a-z/;
			$string = $temp_string if (defined($elements{$temp_string}));

			if (defined $in2{$string}) {
				@values = split(/\\0/,$in2{$string});
				$substitute = $values[$#values];
				substr($ZOT_BODY,$first,$last-$first+1) = $substitute;

				$index = $first+length($substitute)-1;
				$length = $length-length($string)-2+length($substitute);
			} else {
				substr($ZOT_BODY,$first,$last-$first+1) = $string;
				$index = $first+length($string)-1;
				$length -= 2;
			}
		}
	}
	$ZOT_BODY;
}


# The following subroutine searches through a file named at the top of the
# program for an alias that is sent to it.  If the alias is found, then the
# corresponding e-mail address is returned.  If no alias is found, then the
# alias itself is returned.

sub search {
	local ($alias_name) = @_;
        open(ALIASFILE,$Alias_File);
        $alias_name =~ tr/A-Z/a-z/; 
        while ($_ = <ALIASFILE>) {
                $orig = $_;
		#print $orig;
                chop $orig;
                ($alias_value,$email_address) = split(":",$orig,2);
                $alias_value =~ tr/A-Z/a-z/;
		print $alias_value . "\n";
                if ($alias_name eq $alias_value) {
                        return $email_address;
                }
        }
return $alias_name;
}