Desperate for help with deciphering Perl script

[callyvan]

I am hurting here, been tasked with trying to add a bunch of new content to this script, but since it was written 10 years ago and continuously patched up badly since then, I have no clue what does what anymore..can someone comment in text that will at least explain what the different routines do?

_________________________________________________________________________________________

#!/opt/common/perl/bin/perl
##############################################################################
# 			         Form Mail: eMail Form Processor Pro         #
#                              Version 4.0.7 - local copy                    #
##############################################################################
#                           Developer: MitriDAT                              #
#			Modified: Scrotum Taint     			     #
#                            [e-mail]                             #
#                          http://www.email-form.com                         #
#                         Last Modified 14-10-2010                           #
##############################################################################
# Copyright 2000-2010, MitriDAT. All Rights Reserved.                        #
##############################################################################
# init default values (array @, variable $)
@Months=qw(January February March April May June July August September October November December);
#above is an array which stores values using qw function which ends up like this: ("January", "February", "March", "April", "May", "June", "July", "August", 

"September etc...
unshift @Months, "";
#this array now has 13 elements since an empty quote was added to the start
#why not just combine both together into 1 statement?

@Weekdays=	qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
#used in ## DATE FORMATTING section

$error_loop     	= 0;
$browser_out    	= 0;
$content_type		= "Content-Type: text/html\n\n";
#above only used once, not useful as variable.

$cfg_file		= "formprocessorpro.cfg";

#FIX 24/07/2003 - explanation underneath
if (!(-e $cfg_file)) { #Test if the file contained in the variable "$cfg_file" exists, if it does
    if ($ENV{'WINDIR'}) { #If the system environment has a variable called "WINDIR"
	$pt = $ENV{'SCRIPT_FILENAME'}; #Put the contents of the system environment variable "SCRIPT_FILENAME" into the perl var "$pt"
	$pt = $ENV{'PATH_TRANSLATED'} if $ENV{'PATH_TRANSLATED'}; #Put the contents of the system environment variable PATH_TRANSLATED into the pel var "$pt" 

only if the variable exists in the #system environment.
        $pt =~ s/\\/\//g; #Change all the backslashes (\) into forward slashses in the variable "$pt"
	@m = split(/\//,$pt); pop @m; #6) Split up the path contained in the perl variable "$pt" into parts and put them in the array "@m", then remove the 

last path #part on the right, for eg, "/one/two/three" would remove the "three".
	$cfg_file  = join("\x2F",@m).'/formprocessorpro.cfg'; #Join up the paths again, putting a forward slash in between (0x2f is a forward slash 

character) and append the string #'/formprocessorpro.cfg', and put the result into the perl var "$cfg_file"
    }
    $cfg_file =~ s/\/\//\//g; #Replace "//" for "/" (in case there are any double slashes in the string) and put into "$cfg_file"
    }



#/FIX 24/07/2003
$mail_format		= "plain";
$cfg_form		= "form.cfg";
$multi_separator	= ", ";
##############################################################################

use CGI::Carp qw (fatalsToBrowser);
#above may no longer be needed depending on Perl version on server
use CGI qw/:cgi/;
$ENV{'UPDATED'}= ' ';
$query = new CGI;

# default message
if ($ENV{'REQUEST_METHOD'} eq 'GET' and $ENV{'QUERY_STRING'} eq "login") {
    &StartPage;
    exit(0);
}elsif($ENV{'REQUEST_METHOD'} eq 'GET'){
  Error('Request method error.',"Request method error.");
}


@lines = ReadFile2('Configuration File', $cfg_file);
foreach $line (@lines) {
	if ($line =~ /^(Referers)\s*=\s*(.+?)\s*(\x23|$)/)
		{ eval "push \@$1, \"$2\";";}
	elsif ($line =~ /^(\w+)\s*=\s*(.+?)\s*(\x23|$)/)
		{ eval "\$$1 = \"$2\";"; }
}

######whether we shall administrate or not##### the heck does this mean?
if ($query->param('pass09123')) {
$pass09123=$query->param('pass09123');
 	if ($managing_password eq $pass09123) {
			if (defined($query->param('_saveChanges'))) {# we save edited fields
			&SavePage;
			$ENV{'UPDATED'} = "<p align=center><strong><font color=red>Configuration script was updated</font></strong></p>\n";
			&StartPage;
			}
			else {#we only start editing
			&ManagePage;
			}
		} else {#we entered incorrect pwd or didn't enter it at all
		&StartPage;
		}
exit(0);
}
######end of administrating####################

# we can inherit base path if drawn through several pages in page sequence
$stem_base_path = "/sites/webpwtra/data/rh-hr/";
$base_path = $stem_base_path.$query->param('base_path').'/' if defined(($query->param('base_path')));
$base_path = $query->param('_base_path').'/' if defined(($query->param('_base_path')));

@lines=ReadFile2('Form Configuration File', $base_path . $cfg_form);
foreach $line (@lines) {
	if ($line =~ /^(attachments_path|mail_format)\s*=\s*(.+?)\s*(\x23|$)/)
		{eval "\$$1 = \"$2\";";}
	if ($line =~ /^(\w+)\s*=\s*(.+?)\s*(\x23|$)/)
		{ eval "\$FORM{$1} = \"$2\";";}
}
$attachments_path=$base_path . $attachments_path;

&ParseForm;
&CheckRef;

# change Branch e-mail addresses to actual branch or host branch names and insert new key-value into %FORM
############################## change this to case instead of elsif (much cleaner) - Yvan edit ############################
	
	my $branch_email_e = $FORM{r_Branch};
	my $hostbranch_email_e = $FORM{r_Host_Branch};
	
	my $branch_email_f = $FORM{r_Direction_generale};
	my $hostbranch_email_f = $FORM{r_Direction_generale_daccueil};
		
	my $branch_realname_e = '';
	my $branch_realname_f = '';	
	
	if (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq '[e-mail]')) { 

$branch_realname_e = 'Human Resources'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Finance'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Minister’s Office'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Deputy Minister’s Office'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Office of the Chief Risk Officer'; $FORM{'branch_in_emailsubject'} = 

$branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Acquisitions'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Real Property'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Consulting, Information, and Shared Services'; $FORM{'branch_in_emailsubject'} = 

$branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Accounting, Banking and Compensation'; $FORM{'branch_in_emailsubject'} = 

$branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Corporate Services, Policy and Communications'; $FORM{'branch_in_emailsubject'} = 

$branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Information Technology Services'; $FORM{'branch_in_emailsubject'} = 

$branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Audit and Evaluation'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Translation Bureau'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Atlantic Region'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Quebec Region'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Ontario Region'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Western Region'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Pacific Region'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Office of the Procurement  Ombudsman'; $FORM{'branch_in_emailsubject'} = 

$branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Parliamentary Precinct'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
		elsif (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Matane Site'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
		elsif  (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Shediac Site'; $FORM{'branch_in_emailsubject'} = $branch_realname_e; }
		elsif  (($branch_email_e eq '[e-mail]') or ($hostbranch_email_e eq 

'[e-mail]')) { $branch_realname_e = 'Departmental Oversight'; $FORM{'branch_in_emailsubject'} = 

$branch_realname_e; }


############################# missing else statement ################################

	if (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq '[e-mail]')) { 

$branch_realname_f = 'Ressources humaines'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Finances'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Bureau du ministre'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }	
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Bureau du sous-ministre'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Agent principal de gestion des risques'; $FORM{'branch_in_emailsubject'} = 

$branch_realname_f; }
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Approvisionnements'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Biens immobiliers'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Conseils, Information et Services Partagés'; $FORM{'branch_in_emailsubject'} = 

$branch_realname_f; }
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Comptabilité, Gestion bancaire et Rémunération'; $FORM{'branch_in_emailsubject'} = 

$branch_realname_f; }
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Services ministériels,  politiques et communications'; 

$FORM{'branch_in_emailsubject'} = $branch_realname_f; }
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Services d’infotechnologie'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; 

}
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Vérification et l’évaluation'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; 

}
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Bureau de la traduction'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Région de l’Atlantique'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Région du Québec'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Région de l’Ontario'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Région de l’Ouest'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Région du Pacifique'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Bureau de l’ombudsman de l’approvisionnement'; $FORM{'branch_in_emailsubject'} = 

$branch_realname_f; }
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Cité Parlementaire'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
		elsif (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Site de Matane'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
		elsif  (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Site de Shediac'; $FORM{'branch_in_emailsubject'} = $branch_realname_f; }
		elsif  (($branch_email_f eq '[e-mail]') or ($hostbranch_email_f eq 

'[e-mail]')) { $branch_realname_f = 'Surveillance ministérielle'; $FORM{'branch_in_emailsubject'} = 

$branch_realname_f; }
		
############################# missing else statement ################################

$mail_format="plain" if ($ENV{'HTTP_REFERER'}=~/(\/\/|\.)aol\.com/);
$mail_format="plain" if ($ENV{'HTTP_REFERER'}=~/(\/|\.)not/);
#above = not sure, can combine, or omit?

$FORM{'_format_decimals'} = "0" unless ($FORM{'_format_decimals'});
$FORM{'GMT_OFFSET'} = "0" unless ($FORM{'GMT_OFFSET'});

## DATE FORMATTING
$date_format = 'dd.mm.yyyy' unless defined($date_format);
$date = $date_format;
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time + $FORM{'GMT_OFFSET'}*3600);
$mon++; $year+=1900; $syear="0".($year-2000);
$mday="0".$mday if length($mday)<2 ;

	$date=~s/weekday/$Weekdays[$wday]/i;
	$date=~s/wee/substr($Weekdays[$wday],0,3)/ei;
	$date=~s/Month/$Months[$mon]/i;
	$date=~s/mmm/substr($Months[$mon],0,3)/ei;
		$mon=(length($mon)<2?"0":"").$mon;  # "0" schreiben oder nicht?
	$date=~s/yyyy/$year/i;
	$date=~s/yy/$syear/io;
	$date=~s/dd/$mday/io;
	$date=~s/mm/$mon/eio;
$ENV{'DATE_GMT'} = sprintf("%02d:%02d:%02d %s GMT%+d",$hour,$min,$sec,$date,$FORM{'GMT_OFFSET'});
## END DATE FORMATTING


srand(time ^ $$);
$rnd1 = sprintf("%04d", int(rand 10000));
$rnd2 = sprintf("%04d", int(rand 10000));

$FORM{'unique_reference_number'} = "$year$mon$mday-$rnd1-$rnd2" unless ($FORM{'unique_reference_number'});

if (@missing_values or @bad_emails or @only_digits or @only_words) { Error('evil values') }

foreach $key (keys %FORM)
    {
    $FORM{$key} =~s/\0//g;
    $FORM{$key} =~s/\"(\s|\.|\)|\Z)/©$1/g;
    $FORM{$key} =~s/(\A|\s|\.|\()\"/$1½/g;
    #Page number
    $pn=$FORM{'page_no'}; $pn++;
# start_email is hidden field in the form which email has to been sent after
    if ($key =~ /^_send_email/)
        {
        if (!defined($FORM{"_browser_out".$pn})) {
        	@lines = ReadFile('Email Template',$FORM{$key});
        	@lines = ParseText(@lines);
        	@lines = ParseEmail(@lines);
        	if ($mailserver ne '') {SendMailBySmtp(@lines);}  else {SendMail(@lines);}
		}
	}
    elsif ($key =~ /^_send_html_email/)#HTML email template
        {
        if (!defined($FORM{"_browser_out".$pn})) {
        	@lines = ReadFile('Email Template',$FORM{$key});
        	@lines = ParseTextMail(@lines);
        	@lines = ParseHtmlEmail(@lines);
        	if ($mailserver ne '') {SendMailBySmtp(@lines);}  else {SendMail(@lines);}
		}
	}
    elsif ($key =~ /^_out_file/)
        {
        if (!defined($FORM{"_browser_out".$pn})) {
        @lines = ReadFile('Log File',$FORM{$key});
        @lines = ParseText(@lines);
        LogFile('LogFile Template',@lines);
		}
        }
    elsif ($key =~ /^_browser_out$FORM{page_no}$/ and $browser_out < 2)
        {
	$browser_out++;
	@lines = ReadFile('Browser Template', $FORM{$key});
	@lines = ParseText(@lines);
		foreach $line (@lines) {
		 if ($line=~/(<\/form>)/i) {
		 $hfields="";
		 foreach $k (keys %FORM) {
		 	$v=$FORM{$k};
		 	if ($k =~ /^page_no/) {$v++;}
		 	$hfields .= '<input type="hidden" name="'.$k.'" value="'.$v.'">'."\n";
		 	}
		 if (!defined($FORM{page_no})) {$hfields .= '<input type="hidden" name="page_no" value="1">'."\n";}
		 $line=$`.$hfields.$1.$';
		 }
		}
        BrowserOut(@lines);
        }
    elsif ($key =~ /^_redirect/ and $browser_out < 2)
        {
        $browser_out++;
        print "Location: $FORM{$key}\n\n";
        }
    }


unless ($browser_out) {
    @msg = (<DATA>);
    $ENV{'OUT_TITLE'} = "Submission Successful / Transmission de la demande r‰ussie";
    $ENV{'OUT_MSG'}   = "Your submission was successful. Thank you. / La transmission de votre demande est r‰ussie. Merci.";
    @msg              = ParseText(@msg);
    BrowserOut(@msg);
}

	opendir(DIR, $attachments_path) || exit(0);
	@files_list = grep { /^\d{8}_(.*)_\._file$/ && -f "$attachments_path$_" } readdir(DIR);
	closedir DIR;
	foreach $attachment_file (@files_list) {
		($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat($attachments_path.$attachment_file);
	    if (time() >= $mtime + $attachments_ttl) {
			unlink($attachments_path.$attachment_file);
	    }
	}

exit(0);

### Subroutines ###

sub round
{
	$value = shift @_;
	$round_dec = shift @_;
	$round_dec = $FORM{'_format_decimals'} if ($round_dec eq "");
	return sprintf("%.".$round_dec."f", $value);

}#round

sub BrowserOut
{
	print "$content_type@_\n";
}#BrowserOut

sub CheckRef
{
    my ($valid_referer, @terms);

    if ((@Referers) and ($ENV{'HTTP_REFERER'})) {
        foreach $referer (@Referers) {
            if ($ENV{'HTTP_REFERER'} =~ m|http.*?://$referer|i) {
                $valid_referer++;
                last;
            }
        }
    } else {
    	$valid_referer++;
    }
    unless ($valid_referer) {
        @terms = split(/\//,$ENV{'HTTP_REFERER'});
    Error ('Bad Referer',
            "'$ENV{'HTTP_REFERER'}' is not authorised to use this script. If you want them to be able to,
            you should add '$terms[2]' to the referer list."
            );
	}
}#CheckRef

sub Error
{
    ++$error_loop;
    my $title = shift @_;
    my $msg   = shift @_;
    my @error;


# french stuff below, can and should be updated.
    if ($title eq 'evil values') {
        my $val;
        if (@missing_values) {
            $msg = qq|<p></p>\n<table border=0><tr><td><ol>\n|;
            foreach $val (@missing_values) {
			if ($val eq 'Direction_generale_daccueil') {
          	$msg .= "<li>Direction g&eacute;n&eacute;rale d'accueil\n";
        	} 
			elsif ($val eq 'Direction_generale') {
          	$msg .= "<li>Direction g&eacute;n&eacute;rale\n"; }
			elsif ($val eq 'Premiere_entente_daffectation_OU') {
          	$msg .= "<li>Premi&egrave;re entente d'affectation OU Prolongation d'entente d'affectation\n"; }
			elsif ($val eq 'Laffectation_comblera_un_poste_existant') {
          	$msg .= "<li>L'affectation comblera un poste existant OU L'affectation ne comblera pas un poste existant\n"; }					
			elsif ($val eq 'Secteur_daccueil') {
          	$msg .= "<li>Secteur d'accueil\n"; }
			elsif ($val eq 'Lieu_geographique') {
          	$msg .= "<li>Lieu g&eacute;ographique\n"; }
			elsif ($val eq 'Numero_du_poste') {
          	$msg .= "<li>Num&eacute;ro du poste\n"; }
			elsif ($val eq 'Titre_daffectation') {
          	$msg .= "<li>Titre d'affectation\n"; }
			elsif ($val eq 'Exigences_linguistiques') {
          	$msg .= "<li>Exigences linguistiques\n"; }
			elsif ($val eq 'Est-ce_que_lemploye_satisfait_aux_exigences_linguistiques') {
          	$msg .= "<li>Est-ce que l'employ&eacute;(e) satisfait aux exigences linguistiques de l'affectation?\n"; }
			elsif ($val eq 'Exigences_en_matiere_de_securite') {
          	$msg .= "<li>Exigences en mati&egrave;re de s&eacute;curit&eacute;\n"; }			
			elsif ($val eq 'Date_dentree_en_vigueur') {
          	$msg .= "<li>Date d'entr&eacute;e en vigueur\n"; }	
			elsif ($val eq 'Date_dexpiration') {
          	$msg .= "<li>Date d'expiration\n"; }							
			elsif ($val eq 'Nom_du_gestionnaire_dattache') {
          	$msg .= "<li>Nom du gestionnaire d'attache\n"; }
			elsif ($val eq 'Horaire_de_travail') {
          	$msg .= "<li>Horaire de travail\n"; }
			elsif ($val eq 'Objectifs_et_fonctions_de_laffectation') {
          	$msg .= "<li>Objectifs et fonctions de l'affectation\n"; }
			elsif ($val eq 'Numero_de_liste_de_paye') {
          	$msg .= "<li>Num&eacute;ro de liste de paye\n"; }
			elsif ($val eq 'Niveau_de_securite_de_lemploye') {
          	$msg .= "<li>Niveau de s&eacute;curit&eacute; de l'employ&eacute;\n"; }			
			elsif ($val eq 'Date_dexpiration_de_la_cote_de_securite') {
          	$msg .= "<li>Date d'expiration de la cote de s&eacute;curit&eacute;\n"; }	
			elsif ($val eq 'Nom_de_lagent_de_securite_de_service') {
          	$msg .= "<li>Nom de l'agent de s&eacute;curit&eacute; de service qui a confirm&eacute; la cote de s&eacute;curit&eacute; de 

l'employ&eacute;(e)\n"; }				
			elsif ($val eq 'Premiere_entente_detachement_OU') {
          	$msg .= "<li>Premi&egrave;re entente de d&eacute;tachement OU Prolongation d'entente de d&eacute;tachement\n"; }			
			elsif ($val eq 'Le_detachement_comblera_un_poste_existant') {
          	$msg .= "<li>Le d&eacute;tachement comblera un poste existant OU Le d&eacute;tachement ne comblera pas un poste existant\n"; }			

	
			elsif ($val eq 'Titre_en_detachement') {
          	$msg .= "<li>Titre en d&eacute;tachement\n"; }
			elsif ($val eq 'Est-ce_que_lemploye_satisfait_aux_exigences_linguistiques') {
          	$msg .= "<li>Est-ce que l'employ&eacute;(e) satisfait aux exigences linguistiques du d&eacute;tachement?\n"; }
			elsif ($val eq 'Objectifs_et_fonctions_du_detachement') {
          	$msg .= "<li>Objectifs et fonctions du d&eacute;tachement\n"; }
			elsif ($val eq 'Premiere_langue_officielle') {
          	$msg .= "<li>Premi&egrave;re langue officielle\n"; }
			elsif ($val eq 'Langue_officielle_preferee') {
          	$msg .= "<li>Langue officielle pr&eacute;f&eacute;r&eacute;e\n"; }
			elsif ($val eq 'Preferred_langue_officielle') {
          	$msg .= "<li>Langue officielle pr&eacute;f&eacute;r&eacute;e\n"; }
			elsif ($val eq 'Ministere_dattache') {
          	$msg .= "<li>Minist&egrave;re d'attache\n"; }
			elsif ($val eq 'Numero_de_poste_dattache') {
          	$msg .= "<li>Num&eacute;ro de poste d'attache\n"; }
			elsif ($val eq 'Nom_et_coordonnees_du_Conseiller') {
          	$msg .= "<li>Nom et coordonn&eacute;es du Conseiller en r&eacute;mun&eacute;ration au minist&egrave;re d'attache\n"; }
			elsif ($val eq 'Groupe_et_niveau') {
          	$msg .= "<li>Groupe et niveau\n"; }
			elsif ($val eq 'Emploi_occasionnel_initial') {
          	$msg .= "<li>Emploi occasionnel initial ou prolongation d'emploi occasionnel\n"; }
			elsif ($val eq 'Date_dentree_en_vigueur_proposee') {
          	$msg .= "<li>Date d'entr&eacute;e en vigueur propos&eacute;e\n"; }
			elsif ($val eq 'Prenom') {
          	$msg .= "<li>Pr&eacute;nom\n"; }			
			elsif ($val eq 'CIDP_numero') {
          	$msg .= "<li>Num&eacute;ro de CIDP\n"; }
			elsif ($val eq 'Est-ce_que_la_personne_satisfait_aux_exigences_linguistiques') {
          	$msg .= "<li>Est-ce que la personne satisfait aux exigences linguistiques?\n"; }
			elsif ($val eq 'Date_dentree_en_vigueur_de_la_cote_de_securite') {
          	$msg .= "<li>Date d'entr&eacute;e en vigueur de la cote de s&eacute;curit&eacute;\n"; }
			elsif ($val eq 'Curriculum_vitae') {
          	$msg .= "<li>Curriculum vitae\n"; }
			elsif ($val eq 'Nom_du_gestionnaire_titulaire_des_pouvoirs_subdelegues_en_matiere_de_dotation') {
          	$msg .= "<li>Nom du gestionnaire titulaire des pouvoirs subd&eacute;l&eacute;gu&eacute;s en mati&egrave;re de dotation\n"; }
			elsif ($val eq 'Nom_du_gestionnaire_titulaire_des_pouvoirs_financiers_subdelegues') {
          	$msg .= "<li>Nom du gestionnaire titulaire des pouvoirs financiers subd&eacute;l&eacute;gu&eacute;s\n"; }
			elsif ($val eq 'Unite_organisationnelle') {
          	$msg .= "<li>Unit&eacute; organisationnelle\n"; }
			elsif ($val eq 'Ministere_expediteur') {
          	$msg .= "<li>Minist&egrave;re exp&eacute;diteur\n"; }
			elsif ($val eq 'Nom_et_coordonnees_du_la_Conseiller') {
          	$msg .= "<li>Nom et coordonn&eacute;es du (de la) Conseiller(&egrave;re) en r&eacute;mun&eacute;ration au minist&egrave;re 

exp&eacute;diteur\n"; }
			elsif ($val eq 'Est-ce_que_la_personne_proposee_pour_mutation_satisfait_A_la_norme') {
          	$msg .= "<li>Est-ce que la personne propos&eacute;e pour mutation satisfait &agrave; la norme de qualification pour le groupe professionnel 

du poste &agrave; combler?\n"; }
			elsif ($val eq 'Groupe_professionnel_pertinent') {
          	$msg .= "<li>Groupe professionnel pertinent\n"; }
			elsif ($val eq 'Numero_de_poste_du_superviseur_immediate') {
          	$msg .= "<li>Num&eacute;ro de poste du superviseur imm&eacute;diat\n"; }
			elsif ($val eq 'Premiere_demande_en_vertu_dun_programme_etudiant_ou_reemploi_dun_etudiant_une_etudiante') {
          	$msg .= "<li>Premi&egrave;re demande en vertu d'un programme &eacute;tudiant ou r&eacute;emploi d'un &eacute;tudiant/une &eacute;tudiante\n"; 

}
			elsif ($val eq 'Groupe_professionnel_pertinent') {
          	$msg .= "<li>Groupe professionnel pertinent\n"; }
			elsif ($val eq 'Numero_de_poste_du_superviseur_immediat') {
          	$msg .= "<li>Num&eacute;ro de poste du superviseur imm&eacute;diat\n"; }
			elsif ($val eq 'Code_de_centre_de_responsabilite') {
          	$msg .= "<li>Code de centre de responsabilit&eacute;\n"; }	
			elsif ($val eq 'Codage_financier') {
          	$msg .= "<li>Codage financier\n"; }			
			elsif ($val eq 'Code_organisationnel') {
          	$msg .= "<li>Code organisationnel\n"; }
			elsif ($val eq 'Code_de_reference') {
          	$msg .= "<li>Code de r&eacute;f&eacute;rence\n"; }	
			elsif ($val eq 'Codage_financier_dattache') {
          	$msg .= "<li>Codage financier de l'organisme d'attache\n"; }
			elsif ($val eq 'Code_organisationnel_dattache') {
          	$msg .= "<li>Code organisationnel de l'organisme d'attache\n"; }
			elsif ($val eq 'Code_de_reference_dattache') {
          	$msg .= "<li>Code de r&eacute;f&eacute;rence de l'organisme d'attache\n"; }
			elsif ($val eq 'Codage_financier_daccueil') {
          	$msg .= "<li>Codage financier de l'organisme d'accueil\n"; }
			elsif ($val eq 'Code_organisationnel_daccueil') {
          	$msg .= "<li>Code organisationnel de l'organisme d'accueil\n"; }
			elsif ($val eq 'Code_de_reference_daccueil') {
          	$msg .= "<li>Code de r&eacute;f&eacute;rence de l'organisme d'accueil\n"; }
			elsif ($val eq 'Code_dadresse_postale') {
          	$msg .= "<li>Code d'adresse postale\n"; }			
			elsif ($val eq 'Clauses_speciales') {
          	$msg .= "<li>Clauses sp&eacute;ciales\n"; }				
			elsif ($val eq 'Nom_de_la_personne_qui_soumet_la_demande') {
          	$msg .= "<li>Nom de la personne qui soumet la demande\n"; }
			elsif ($val eq 'Adresse_de_courriel_de_la_personne_qui_soumet_la_demande') {
          	$msg .= "<li>Adresse de courriel de la personne qui soumet la demande\n"; }
			elsif ($val eq 'Nom_du_gestionnaire_qui_est_subdelegue_en_matiere_de_dotation') {
          	$msg .= "<li>Nom du gestionnaire qui est subd&eacute;l&eacute;gu&eacute; en mati&egrave;re de dotation\n"; }					

	
			elsif ($val eq 'Nom_du_gestionnaire_qui_est_subdelegue_en_matiere_financiere') {
          	$msg .= "<li>Nom de gestionnaire qui est subd&eacute;l&eacute;gu&eacute; en mati&egrave;re financi&egrave;re\n"; }
			else {
			$msg .= "<li>$val\n"; }
			}						

            $msg .= "</ol></td></tr></table>\n";
		}

        if (@bad_emails) {
            $msg .= qq|<p></p>\n<table border=0><tr><td><ol>\n|;
            foreach $val (@bad_emails) { $msg .= "<li>$val\n" }
            $msg .= "</ol></td></tr></table>\n";
		}
        if (@only_digits) {
            $msg .= qq|<p></p>\n<table border=0><tr><td><ol>\n|;
            foreach $val (@only_digits) { $msg .= "<li>$val\n" }
            $msg .= "</ol></td></tr></table>\n";
        }
        if (@only_dig_and_dolar) {
            $msg .= qq|<p></p>\n<table border=0><tr><td><ol>\n|;
            foreach $val (@only_dig_and_dolar) { $msg .= "<li>$val\n" }
            $msg .= "</ol></td></tr></table>\n";
        }
        if (@only_words) {
            $msg .= qq|<p></p>\n<ol type="i">\n|;
            foreach $val (@only_words) { $msg .= "<li>$val\n" }
            $msg .= "</ol>\n";
        }
		$title = '';
		$msg .= qq|<p></p>\n|;
	}
    if ($FORM{'_error_url'}) {
    	print "Location: $FORM{'_error_url'}\n\n"

    } elsif ($FORM{'_error_path'} and $error_loop < 2) {
        $ENV{'OUT_TITLE'} = $title;
        $ENV{'OUT_MSG'}   = $msg;
        @error = ReadFile('Error Template',$FORM{'_error_path'});
        @error = ParseText(@error);
        BrowserOut(@error);
	} else {
        @error = (<DATA>);
        $ENV{'OUT_TITLE'} = $title;
        $ENV{'OUT_MSG'}   = $msg;
        @error = ParseText(@error);
        BrowserOut(@error);
	}
    exit(0);
}#Error

sub LogFile
{
    my $msg  =  shift @_;
    my $file =  shift @_;

    $file =~ s#^(\s)#./$1#;
    my $file_secure    =  $base_path . $file;
unless ($file_secure =~ m#^(.+)$#) {                  # $1 is untainted
    Error('File Name Error', "filename '$file_secure' has invalid characters / Caract&egrave;res invalides dans le nom de fichier.");
}
$file_secure = $1;
    open(FILE,">>$file_secure") or Error('File Access Error',"An error occurred when trying to append to the $msg ($file): $!");
    if (!defined($ENV{'COMSPEC'})) { # flock ain't needed on Windows !NT based systems
    flock(FILE,2)        or Error('File Lock Error',"An error occured when locking the $msg ($file): $!.");
	}
    print FILE @_;
    close(FILE)          or Error('File Close Error',"An error occurred when close the $msg ($file): $!.");

}#LogFile

sub ReadFile
{
    my $msg  =  shift @_;
    my $file =  shift @_;

	$file =~ s#^(\s)#./$1#;
    $file    = $base_path . $file;
    open(FILE, "$file") or Error('File Access Error',"An error occurred when opening the $msg ($file): $!.");
    my @lines = (<FILE>);
    close(FILE)         or Error('File Close Error',"An error occurred when closing the $msg ($file): $!.");
    return @lines;

}#ReadFile

sub ReadFile2
{
    my $msg  =  shift @_;
    my $file =  shift @_;

	$file =~ s#^(\s)#./$1#;
    open(FILE, "$file") or Error('File Access Error',"An error occurred when opening the $msg ($file): $!.");
    my @lines = (<FILE>);
    close(FILE)         or Error('File Close Error',"An error occurred when closing the $msg ($file): $!.");
    return @lines;

}#ReadFile2

sub ParseForm
{
    my ($key, $prefs, $buffer, $file, $local_file, $value, $name, $file_name);


	@names = $query->param;

    foreach $name (@names)
	{
		$value = $query->param($name);

        #FIX 07.07.2003
           if ($mail_format eq 'html') {
          	$value =~s/\n/\<br\>/ig;
        	}

        $FORM{$name} = $value;

		if ($bytesread = read($value, $buffer, 1024)) {
			$file_name = $value;
			if ($file_name =~ /([^\/\\:]*)$/) {
				$file_name = $1;
			}
			my $t_size = 0;
			srand(time ^ $$);
			my $rnd = sprintf("%08d", int(rand 100000000));
			$local_file = $attachments_path . $rnd . "_" . $file_name . "_._file";
			$FORM{$name."_uploaded"} = $rnd . "_" . $file_name . "_._file";
			open (OUTFILE,">$local_file")  or Error('File Access Error',"An error occurred when trying to save attachments / Une erreur s'est 

produite au moment d'enregistrer les pi&egrave;ces jointes ($local_file): $!");
			binmode OUTFILE;
			$t_size = length($buffer);
			print OUTFILE $buffer;
			while ($bytesread = read($value, $buffer, 1024)) {
				$t_size += length($buffer);
				print OUTFILE $buffer;
			}
			close OUTFILE;
			
			my $f_size = 1024 * $max_file_size;
			$lang_id = $query->param('lang_id');
			if($t_size > $f_size && $f_size != 0) {
				unlink($local_file);
				if ($lang_id eq 'form-e') {
				Error("Uploading file is too large. It must to be less than $max_file_size KB.");
						}
				else	{	
				Error("Le fichier &agrave; t&eacute;l&eacute;charger est trop volumineux. Il ne doit pas exc&eacute;der $max_file_size Ko.");	

				}
            		}

        } else {
        	if ($name =~ /^([rs]*[edwmcn]?[rs]*)_/) {

	            ($prefs, $key) = split /_/, $name, 2;

	            if ($prefs =~ /s/i and $value) {
	            	$value =~ s/^(\s)*//;
	                $value =~ s/(\s)*$//;
	                $FORM{$name} = $value;
	            }

	            if ($prefs =~ /m/i and $value) {
					$multi_separator = $FORM{'_multi_separator'} if defined($FORM{'_multi_separator'});
					@value = $query->param($name);
	            	$value = join($multi_separator,@value);
	            	$value =~ s/^default$multi_separator|^default//ig;
            		$FORM{$name} = $value;
				}
	            if ($prefs =~ /n/i and $value) {
					$value =~ s/\n//ig;
					$value =~ s/\r//ig;
            		$FORM{$name} = $value;
	            }

	            if ($prefs =~ /r/i and $value eq "")
	            	{ push @missing_values, $key }
	            if ($prefs =~ /e/i and $value and isEmailBad($value))
	            	{ push @bad_emails, $key     }
	            if ($prefs =~ /d/i and $value and !($value =~ /^(\d+|\d+\.\d+)$/))
	            	{ push @only_digits, $key    }
	            if ($prefs =~ /c/i and $value and !($value =~ /^(\$?\d+\$?|\$?\d+\.\d+\$?)$/))
	            	{ push @only_dig_and_dolar, $key   }
	            if ($prefs =~ /w/i and $value and $value =~ /\W/)
	            	{ push @only_words, $key     }
			}
		}
    }
}#ParseForm

sub ParseText
{
    my ($line, $key, $value, $sub, $script);
        
    foreach $line (@_) {
        while (($key => $value) = each %FORM)
            { $line =~ s/\[$key\]/$value/ig }
        while (($key => $value) = each %ENV)
            { $line =~ s/\[\%$key\]/$value/ig }
	if ($line =~ /<script/) {$script = 1;}
	if ($script != 1) {
			$line =~ s/\[[^<](.)*?[^>]\]//g;
		} else {
			$line =~ s/([^A-Za-z0-9\-_,])\[[^<](.)*?[^>]\]/$1/g;
		}
	if ($line =~ /<\/script/) {$script = 0;}
	}
    foreach $line (@_) {
        while ($line =~ /\[<((.)*?)>\]/) {
            $sub = $1;

			if ($sub !~ /^([\d\+\*\/\-%\.,x<>\(\)\s]|round|ifcond)*$/s) {
				#Error("Error in expression", $sub);
			}
			$sub = eval $sub;
            $line =~ s/\[<(.)*?>\]/$sub/s;
         }
    }
    return @_;

}#ParseText

sub ParseTextMail
{
    my ($line, $key, $value, $sub, $script);
        
    foreach $line (@_) {
        while (($key => $value) = each %FORM)
            {         
            	$value =~ s/\n/\<br\>/g;
            	$line =~ s/\[$key\]/$value/ig             
            }
        while (($key => $value) = each %ENV)
            { $line =~ s/\[\%$key\]/$value/ig }
		$line =~ s/\x7e(\w+)((\[)(\d)(\]))?/eval "\$$1$3$4$5"/e;
    }
    return @_;

}#ParseTextMail

sub ifcond
{
	$cond = shift @_;
	$res1 = shift @_;
	$res2 = shift @_;

	if($cond) {
		return sprintf("%s", $res1);
	} else {
		return sprintf("%s", $res2);
	}

}#ifcond

sub ParseEmail
{
    my ($line, $attachment_file, $add2email, $real_name, @email);
    $add2email = "";
    foreach $line (@_)
    {
	   	if (($line =~ /^Subject: (.+)\n$/i) and ($mail_format eq 'html')) {
			$sline = $line."Content-Type: text\/html; charset=ISO-8859-1\n";
			$line =~ s/^Subject: (.+)\n$/$sline/i;
   		}
    	if ($line =~ /^Attachment: (.+)$/i)
    	{
	   		my @files = split (/,/, $1);
    		foreach $attachment_file (@files)
    		{
            	$attachment_file =~ s/(^\s*|\s*$)//g;
		if (length($attachment_file)>0) {
				if ($attachment_file =~ /([^\/\\:]*)$/)
				{
					$attachment_file = $1;
				}

                if ($attachment_file =~ /^\d{8}_(.*)_\._file$/)
                	{$real_name = $1;}
                 else	{$real_name = $attachment_file;}

#FIX
   			    if (-e $attachments_path . $attachment_file)
   			    {
				$add2email .= "---2099962873-1165733044-991133573=:5283\n";
				$add2email .= "Content-Transfer-Encoding: BASE64\n";
				$add2email .= "Content-Disposition: attachment; filename=\"$real_name\"\n\n";

					open(FILE, $attachments_path . $attachment_file) or Error("Error while opening attachment file / Une erreur s'est 

produite au moment d'ouvrir la pi&egrave;ce jointe.", "\'$attachments_path$attachment_file\', $!");
					binmode FILE;
					while (read(FILE, my $buf, 60*57))
					{
						 $add2email .= encode_base64($buf);
					}
					close FILE;
				}
	   	   }
    		}

    		push @email, "MIME-Version: 1.0\n";
    		push @email, "Content-Type: MULTIPART/MIXED; BOUNDARY=\"-2099962873-1165733044-991133573=:5283\"\n\n";
    		push @email, "  This message is in MIME format.  The first part should be readable text,\n";
    		push @email, "  while the remaining parts are likely unreadable without MIME-aware tools.\n";
    		push @email, "  Send mail to mime\@docserver.cac.washington.edu for more info.\n\n";
    		push @email, "---2099962873-1165733044-991133573=:5283\n";

    	} else 	{
    		# Strip tags if mail format is plain, skipping service info lines
		#$line=~s/<(?:[^>'"]*|(['"]).*?\1)*>//gs if ($mail_format eq "plain" && $line !~ /^(From|To|Cc|Bcc):/i);
		push @email, $line;
	}
    }
    if ($add2email)
    {
		push @email, "\n$add2email";
   		push @email, "---2099962873-1165733044-991133573=:5283--\n";
    }
    return @email;
}#ParseEmail

sub ParseHtmlEmail
{
    my ($line, $attachment_file, $add2email, $real_name, @email);
    $add2email = "";
    
    foreach $line (@_)
    {
	   	if ($line =~ /^Subject: (.+)\n$/i) {
			$sline = $line."Content-Type: text\/html; charset=ISO-8859-1\n";
			$line =~ s/^Subject: (.+)\n$/$sline/i;
   		}

    	if ($line =~ /^Attachment: (.+)$/i)
    	{
	   		my @files = split (/,/, $1);
    		foreach $attachment_file (@files)
    		{
            	$attachment_file =~ s/(^\s*|\s*$)//g;
		if (length($attachment_file)>0) {
				if ($attachment_file =~ /([^\/\\:]*)$/)
				{
					$attachment_file = $1;
				}

                if ($attachment_file =~ /^\d{8}_(.*)_\._file$/)
                	{$real_name = $1;}
                 else	{$real_name = $attachment_file;}

   			    if (-e $attachments_path . $attachment_file)
   			    {
				$add2email .= "---2099962873-1165733044-991133573=:5283\n";
				$add2email .= "Content-Transfer-Encoding: BASE64\n";
				$add2email .= "Content-Disposition: attachment; filename=\"$real_name\"\n\n";

					open(FILE, $attachments_path . $attachment_file) or Error("Error while opening attachment file / Une erreur s'est 

produite au moment d'ouvrir la pi&egrave;ce jointe", "\'$attachments_path$attachment_file\', $!");
					binmode FILE;
					while (read(FILE, my $buf, 60*57))
					{
						 $add2email .= encode_base64($buf);
					}
					close FILE;
				}
	   	   }
    		}

    		push @email, "MIME-Version: 1.0\n";
    		push @email, "Content-Type: MULTIPART/MIXED; BOUNDARY=\"-2099962873-1165733044-991133573=:5283\"\n\n";
    		push @email, "  This message is in MIME format.  The first part should be readable text,\n";
    		push @email, "  while the remaining parts are likely unreadable without MIME-aware tools.\n";
    		push @email, "  Send mail to mime\@docserver.cac.washington.edu for more info.\n\n";
    		push @email, "---2099962873-1165733044-991133573=:5283\n";

    	} else 	{
    		# Strip tags if mail format is plain, skipping service info lines
		#$line=~s/<(?:[^>'"]*|(['"]).*?\1)*>//gs if ($mail_format eq "plain" && $line !~ /^(From|To|Cc|Bcc):/i);
		push @email, $line;
	}
    }
    if ($add2email)
    {
		push @email, "\n$add2email";
   		push @email, "---2099962873-1165733044-991133573=:5283--\n";
    }
    return @email;
}#ParseHtmlEmail


sub isEmailBad
{
	$value = shift @_;
	return (($value =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/) or
				($value !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,6}|[0-9]{1,3})(\]?)$/));
}#isEmailBad

sub SendMailBySmtp
{
	my($line, $var_name, @message);

    unless ($smtp_used) {
		eval "use Net::SMTP";
		if ($@) {
			Error('Net::SMTP init error', "Can't load Net::SMTP module");
	    	return 0;
		}
		$smtp_used = 1;
	}

	@message = @_;
	foreach $line (@message)
	{
		if ($line =~ /^(to|from|b?cc): (.+)$/i)
		{
			$mail_param = $1;
			$mail_val = $2;

			if ($mail_val =~ /<(.+)>/)
			{
				$mail_val = $1;
			}

			$var_name = "mail_".lc($mail_param);
			@$var_name = split(/\x2c(\s*)?/,$mail_val);
		}
	}


	$smtp = Net::SMTP->new($mailserver);
	$smtp->mail($mail_from);
	foreach $mt (@mail_to) {$smtp->recipient($mt);}
	foreach $mt (@mail_cc) {$smtp->recipient($mt);}
	foreach $mt (@mail_bcc) {$smtp->recipient($mt);}
	$smtp->data();
	$smtp->datasend(@_);
	$smtp->dataend();
	$smtp->quit;

        undef $smtp;
        undef @mail_to;
        undef @mail_cc;
        undef @mail_bcc;

}#SendMailBySmtp

sub SendMail
{
    if ($mail_cmd ne "") {
		open(MAIL,"|$mail_cmd") or Error('Mailer Open Error',"An error occurred when trying to open the mailer ($mail_cmd): $!.");
		print MAIL @_;
		print MAIL "\n.\n";
		close(MAIL) or Error('Mail Send Error',"An error occurred when sending the email: $?. Please check the email's headers.");
    }
}#SendMail

sub encode_base64
{
	my $res = "";
	pos($_[0]) = 0;
	while ($_[0] =~ /(.{1,45})/gs) {
		$res .= substr(pack('u', $1), 1);
		chop($res);
	}
	$res =~ tr|` -_|AA-Za-z0-9+/|;
	my $padding = (3 - length($_[0]) % 3) % 3;
	$res =~ s/.{$padding}$/'=' x $padding/e if $padding;
	$res =~ s/(.{1,76})/$1\n/g;
	return $res;
}#encode_base64

sub ManagePage
{
    $ENV{'OUT_TITLE'} = "eMail Form Processor Pro Script Administrative Section";
    $ENV{'OUT_MSG'}   = "";
    #auto set base_path as path to this file
    my($server,$platform) = $ENV{'SERVER_SOFTWARE'} =~ /([A-Za-z0-9\.\/]{1,})\s\(([A-Za-z0-9\s]{1,})\)/;
    $unix=1 if !($platform =~ /Win32/i);
    my(@path) = split(/\//,$ENV{'SCRIPT_FILENAME'});
    pop(@path);
    if(defined($unix)){ $ret='/'; } else { $ret = ''; }
    foreach (@path){ $ret.=$_.'/'; }   
    $ENV{'MYPLATFORM'} = $platform;
    $ENV{'MYPATH'} = $ret;
       
	open (CFILE, "<cform.html") or Error('Config Form Open Error',"An error occurred when opening config form (cform.html): $!. Please check paths and 

file.");
    @msg = <CFILE>;
	close (CFILE) or Error('Config Form Close Error','An error occured while closing the file (cform.html): $!.');   

    @msg = ParseText(@msg);
    BrowserOut(@msg);
    1;                                                         
}#ManagePage

sub SavePage {
&ParseForm;
$mas=0;
@lines = ReadFile2('Configuration File', $cfg_file);
open (FILE, ">$cfg_file") or Error('Config Form Open Error',"An error occurred when opening config file($cfg_file): $!. Please check paths and file 

permissions (Must be 766).");
foreach $line (@lines) {
	if ($line =~ /^(Referers)\s*=\s*(.+?)\s*(\x23|$)/)
		{
		$var_name=$1; $var_value=$2;
		$line=~s/$var_value/$FORM{$var_name.$mas}/ if defined($FORM{$var_name.$mas});
		#print "$var_name === $FORM{$var_name.$mas}<br>";
		$mas++;
		}
	elsif ($line =~ /^(\w+)\s*=\s*(.+?)\s*(\x23|$)/)
		{
		$var_name=$1; $var_value=$2;
		$line=~s/$var_value/$FORM{$var_name}/ if defined($FORM{$var_name});
		}
print FILE $line;
}
close (FILE) or Error('Config Form Close Error','An error occured while closing the file ($cfg_file): $!.');
1;
}#SavePage

sub StartPage {
	$ENV{'UPDATED'}   = "" unless ($ENV{'UPDATED'});
	$ENV{'OUT_TITLE'} = "Form Mail: eMail Form Processor Pro Script";
	$ENV{'OUT_MSG'}   = qq~The latest version of this script and documentation is available from <a href="http://www.email-form.com/">Email-Form</a>.
	<form action=$ENV{'SCRIPT_NAME'} method="POST"><p class="alignCenter">To access configuration, please enter password: <br>
	<input type="password" name="pass09123" value="" />
	<input type="Submit" value=" ..:: OK ::.. " /></form></p>
	~;
    @msg = (<DATA>);
    @msg = ParseText(@msg);
    BrowserOut(@msg);
    1;
}#StartPage

[tlkummell]

Have you tried adding the debugger flag to the first line and then stepping through the code? To turn on the debugger, add a -d to the end of the first line in the program... The one that starts with a #!

Once you have the debugger on, you can get help using the 'h' command, set break points ( b somelinenumber) then continue processing using the 'c' command, execute the next line of code using the 'n' or 's' commands.
Regards,
Terry

[mitchems]

What a mess! It appears that this script is a front-end to send mail (with attachments). If it were me, I'd scrap the entire thing and use a number of perl modules to accomplish the same task in 1/10th the number of lines. I'd also probably use a templating system for the html forms (no one embeds HTML in perl anymore). Or better yet, get a webmail system that out-of-the-box. I mean, in the "send_mail" routine, the scripter is piping the output through (presumably) sendmail (hard to tell since you didn't include the cfg file). If you have to rewrite the entire thing, I'd use MIME Lite for the email and attachments and some sort of date program to take care of the dates.

[callyvan]

thanks for the input, I will strongly consider these answers and I appreciate the advice :-)

[callyvan]

I have started breaking this file down to smaller pieces so I can understand the whole.

@lines = ReadFile2('Configuration File', $cfg_file); 
#puts contents of 2 files into lines array
foreach $line (@lines) {   
#loops through array line by line
    if ($line =~ /^(Referers)\s*=\s*(.+?)\s*(\x23|$)/)
        { eval "push \@$1, \"$2\";";}
    elsif ($line =~ /^(\w+)\s*=\s*(.+?)\s*(\x23|$)/)
        { eval "\$$1 = \"$2\";"; }
}

not too sure what it is trying to do, not very strong with regex....

[d5e5]

I would read it as "If value of $line starts with Referers followed by optional whitespace characters (zero or more) followed by = followed by optional whitespace characters (zero or more) followed by one or more other characters (note the ? lazy quantifier) followed by optional whitespace characters (zero or more) followed by either ascii character 23 (whatever that is) or the end of the $line string..."

[callyvan]

thanks :-)

[d5e5]

You're welcome. Instead of saying 'ascii character 23' I should have said 'the character represented by hexadecimal number 23,' which is the pound sign #.

print "\x23"; # Prints # (Pound sign)