#! /usr/local/bin/perl
# defaults, change these and the #! line to move
$datadir = ".";
$dataurl = "/challenge/Archive/98-99/awardsday";
$header = "header.html";
$footer = "footer.html";
$mail = "chidhkra\@mode.lanl.k12.nm.us";
$datafile = "data.txt";
# the all important error sub routine
sub error
{
($title, @rest) = @_;
$myform = "key value $key $form{$key}
$title
Ooops...
$title
The following error has occurred:
$myform
chidhkra\@mode.lanl.k12.nm.us .
Sorry for the problem
$foot
ERROR
exit(0);
}
sub checkperson
{
local($pre, %form) = @_;
local($pres) = sprintf("%ss", $pre);
error("$pre missing or incomplete",
"$pres entry was missing or incomplete from the submission")
unless $form{$pres};
error("form sent wrong data", "$pres was out of range")
unless ($form{$pres} eq "Male" ||
$form{$pres} eq "Female" ||
$form{$pres} eq "-");
}
#from sanity check needs check person
sub formsanity
{
local(%form) = @_;
local($pre);
foreach $pre ("t1", "t2", "a", "d", "s1", "s2", "s3", "s4", "s5")
{
checkperson($pre, %form);
}
}
# setsexopt, sets up the html options for different Genders passed in
sub setsexopt
{
local($sex) = @_;
$sexopt = "Male - Female";
$sexopt = " Male Female" if $sex eq
"Male";
$sexopt = " Male Female" if $sex eq
"Female";
return($sexopt);
}
# settourday, sets up the html options for which day they want to tour
sub settourday
{
local($tourday) = @_;
$tourdayopt = " Tuesday Wednesday";
$tourdayopt = " Tuesday Wednesday"
if $tourday eq "Tuesday";
$tourdayopt = " Tuesday Wednesday"
if $tourday eq "Wednesday";
return ($tourdayopt);
}
# setcomingopt, sets the html options for different answers to coming
sub setcomingopt
{
local($coming) = @_;
local($comingopt);
if($coming eq "on")
{
$comingopt = "checked";
}
return($comingopt);
}
# print form, prints the form out, requires, setsexopt, setcomingopt
sub printform
{
local($msg, %form) = @_;
local($action) = $ENV{'SCRIPT_NAME'};
local($monthopt) = " April";
$monthopt = " April May" if $form{'month'} eq "April";
local($dayopt) = " 28 29 1 2 3";
$dayopt = " 28 29 1 2 3" if
$form{'day'} eq "28";
$dayopt = " 28 29 1 2 3" if
$form{'day'} eq "29";
$dayopt = " 28 29 1 2 3" if
$form{'day'} eq "2";
$dayopt = " 28 29 1 2 3" if
$form{'day'} eq "3";
local($t1s) = setsexopt($form{'t1s'});
local($t2s) = setsexopt($form{'t2s'});
local($as) = setsexopt($form{'as'});
local($ds) = setsexopt($form{'ds'});
local($s1s) = setsexopt($form{'s1s'});
local($s2s) = setsexopt($form{'s2s'});
local($s3s) = setsexopt($form{'s3s'});
local($s4s) = setsexopt($form{'s4s'});
local($s5s) = setsexopt($form{'s5s'});
local($t1c) = setcomingopt($form{'t1c'});
local($t2c) = setcomingopt($form{'t2c'});
local($ac) = setcomingopt($form{'ac'});
local($dc) = setcomingopt($form{'dc'});
local($s1c) = setcomingopt($form{'s1c'});
local($s2c) = setcomingopt($form{'s2c'});
local($s3c) = setcomingopt($form{'s3c'});
local($s4c) = setcomingopt($form{'s4c'});
local($s5c) = setcomingopt($form{'s5c'});
local($t1h) = setcomingopt($form{'t1h'});
local($t2h) = setcomingopt($form{'t2h'});
local($ah) = setcomingopt($form{'ah'});
local($dh) = setcomingopt($form{'dh'});
local($s1h) = setcomingopt($form{'s1h'});
local($s2h) = setcomingopt($form{'s2h'});
local($s3h) = setcomingopt($form{'s3h'});
local($s4h) = setcomingopt($form{'s4h'});
local($s5h) = setcomingopt($form{'s5h'});
local($distance) = setcomingopt($form{'distance'});
local($tourday) = settourday($form{'tourday'});
if($msg ne "")
{
print "The following problems were found with your
form:
Note: Teams must submit a final report in order to attend Awards Day
Team number $form{'team'} is out of range";}
foreach $pre ("t1", "t2", "a", "d", "s1", "s2", "s3", "s4", "s5")
{
$coming = sprintf("%sc", $pre);
$last = sprintf("%sl", $pre);
$first = sprintf("%sf", $pre);
$middle = sprintf("%sm", $pre);
$sex = sprintf("%ss", $pre);
if($form{$coming} eq "on")
{
$msg .= "
Last name missing for $form{$first}"
unless $form{$last};
$msg .= "
First name missing for $form{$last}"
unless $form{$first};
$msg .= "
Gender missing for $form{$last}"
unless ($form{$sex} ne "-");
}
}
$msg .= "
Contact name was missing"
unless ($form{'contactf'} && $form{'contactl'});
$msg .= "
Contact email was missing"
unless $form{'contactm'};
$msg .= "
Contact phone number was missing"
unless $form{'contactp'};
return($msg);
}
sub escape
{
local(@list) = @_;
foreach $var (@list)
{
$var =~ s/\\/\\\\/g;
$var =~ s/:/\\:/g;
$var =~ s/!/\\!/g
}
return(@list);
}
sub saveindividual
{
local($title, $pre, %form) = @_;
local($last) = sprintf("%sl", $pre);
local($first) = sprintf("%sf", $pre);
local($middle) = sprintf("%sm", $pre);
local($sex) = sprintf("%ss", $pre);
local($us) = sprintf("%sh", $pre);
$us = $form{$us} eq "on" ? "US" : "foreign";
#error("We made it this far!");
($title, $last, $first, $middle, $sex) = escape($title, $form{$last},
$form{$first}, $form{$middle}, $form{$sex});
return "$title:$last:$first:$middle:$sex:$us\n";
}
sub savedata
{
local(%form) = @_;
error("Datafile missing", "The data file $datafile does not exist")
unless -e $datafile;
open(datafile, ">> $datafile") ||
error("Problem opening datafile", "Cannot open datafile
$datafile: $!");
($form{'team'}, $form{'school'}) =
escape($form{'team'}, $form{'school'});
$form{'distance'} = $form{'distance'} eq "on" ? "far" : "near";
print datafile "#$form{'team'}:$form{'school'}:$form{'distance'}\n";
print datafile saveindividual("teacher", "t1", %form)
unless $form{'t1c'} ne "on";
print datafile saveindividual("teacher", "t2", %form)
unless $form{'t2c'} ne "on";
print datafile saveindividual("advisor", "a", %form)
unless $form{'ac'} ne "on";
print datafile saveindividual("driver", "d", %form)
unless $form{'dc'} ne "on";
print datafile saveindividual("student", "s1", %form)
unless $form{'s1c'} ne "on";
print datafile saveindividual("student", "s2", %form)
unless $form{'s2c'} ne "on";
print datafile saveindividual("student", "s3", %form)
unless $form{'s3c'} ne "on";
print datafile saveindividual("student", "s4", %form)
unless $form{'s4c'} ne "on";
print datafile saveindividual("student", "s5", %form)
unless $form{'s5c'} ne "on";
($form{'contactf'}, $form{'contactl'}, $form{'contactm'}, $form{'contactp'}) =
escape($form{'contactf'}, $form{'contactl'}, $form{'contactm'}, $form{'contactp'});
print datafile "contact:$form{'contactf'}:$form{'contactl'}:$form{'contactm'}:$form{'contactp'}\n";
print datafile "Tour day:$form{'tourday'}\n";
# print datafile saveindividual("contact", "con", %form);
close(datafile);
}
sub printthanks
{
local(%form) = @_;
local($seeyou) = "April 27th";
$seeyou = "April 28th" unless $form{'distance'} eq "on";
print<<"THANKS";
Your registration is complete. If you have any problems or have any changes,
please send mail to
chidhkra\@mode.lanl.k12.nm.us . We're looking forward to seeing you on $seeyou.
THANKS
}
# get the header and footer, report errors if necessary
-e "$datadir/$header" || &error("Cannot open header file",
"Header file $datadir/$header does not exist.");
open(header, "$datadir/$header")
|| &error("Cannot open header file",
"Cannot open header file $datafile/$header because $!.");
$head = "";
while()
{$head .= $_; }
close(header);
-e "$datadir/$footer" || &error("Cannot open footer file",
"Footer file $datadir/$footer does not exist.");
open(footer, "$datadir/$footer")
|| &error("Cannot open footer file",
"Cannot open footer file $datafile/$footer because $!.");
$foot = "";
while()
{$foot .= $_; }
close(footer);
# get our data from the web form
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $buffer);
foreach $pair (@pairs)
{
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$form{$name} = $value;
}
# time to do our work
#error("Form Check!", "This is just a form check.");
if($form{'submit'} ne "submit") # ie, this is the first request
{
print "Content-type: text/html\n\n\n";
print $head;
printform();
print $foot;
}
else # we have data
{
formsanity(%form); # check the form out for sanity
#error("Checking...", "Checking...");
$msg = checkdata(%form);
if(!$msg)
{
savedata(%form);
print "Content-type: text/html\n\n\n";
print $head;
printthanks(%form);
print $foot;
}
else
{
print "Content-type: text/html\n\n\n";
print $head;
printform($msg, %form);
print $foot;
}
}
exit(0);
