CGI Script

Sample HTML:
******************************************

Test for feedback form

*****************************************
Perl script
*****************************************

#!/eesd/ofc/bin/perl -I/eesd/ofc/lib/perl/lib -I /home/ledtools/ofc/perl/lib

#########################################################################
#
# formhandler.cgi
#
# script author: M. Nikole Hunn
#
#########################################################################

use strict;
use CGI qw(:all);

# In will have all form variables. Do not edit.
my %In = ();
my $key;

#########################################################################
# customizable variables

# Set this to the name of the output file (if any), full path from machine root.
# If no file is to be used, use the empty string ("").
# Example: my $outFileName = "/home/myDir/myOtherDir/myFilename";
my $outFileName = "";

# Set this to the name of the outgoing mail server, if using mail option.
# Leave blank if no mail.
# Example: my $mailServer = "myMailServer.com";
my $mailServer = "";

# Set this to the list of primary addresses to mail the form data to.
# Leave blank if no mail ("").
# Some systems require this to backslash-escape the @ sign.
# Example: my $mailList = "me\@myISP.com";
my $mailList = "";

## NOTE: to use bcc and cc, a primary mailList must be specified as well.

# Set this to the list of cc addresses to mail the form data to.
# Leave blank if no cc ("").
# Some systems require this to backslash-escape the @ sign.
# Example: my $ccList = "them\@theirISP.com";
my $ccList = "";

# Set this to the list of bcc addresses to mail the form data to.
# Leave blank if no bcc ("").
# Some systems require this to backslash-escape the @ sign.
# Example: my $bccList = "them\@theirISP.com";
my $bccList = "";

###Perl script continued...

# Set this to the page (full http path) to be used as a success page.
# Leave blank if no redirect desired. ("")
# Example my $successPage = "http://www.myServer.com/myPage.asp";
my $successPage = "";

# Set this to the page (full http path) to be used as a failure page.
# Leave blank if no redirect desired. ("")
# Error messages are passed to the page via the URL to be parsed out if desired
# Example my $failurePage = "http://www.myServer.com/myPage.asp";
my $failurePage = "";

#################################################################################
# begin form processing

# Get the data that was supposed to be passed in from the form
parse();

# Check for _required vars - all form elements that are required have a hidden form element passed in with the name
# varName_required. I.E. if one has a field called "address" and wants it to be non-blank, one also has a hidden
# form field called "address_required". The value ofthat hidden form field is the error message to be output.
my $loc;
my $vr;
my $key2;
my $found=0;

foreach $key (sort keys(%In))
{
$loc=index($key,"_required");
if ($loc > 0)
{
$found=0;
$vr=substr($key,0,$loc);
foreach $key2 (sort keys(%In))
{
if ($key2 eq $vr)
{
$found=1;
last;
}
}
if ($found == 1)
{
$_ = $In{$vr};
if (/^\s*$/) {
printError ($In{vr}, $failurePage);
}
}
else
{
# Radio buttons and checkboxes send nothing if left blank.
printError ($In{$vr."_required"}, $failurePage); }
}
}

### Perl script cont...

# Process form elements as needed.
if ($outFileName ne "")
{
open(MYFILE, ">$outFileName") || printError ("Can't open $outFileName", $failurePage);
flock(MYFILE, 2);
foreach $key (sort keys(%In)) {
print MYFILE "$key = $In{$key}\n";
}
close(MYFILE);
}

if ($mailList)
{
open (MESSAGE,"| /usr/lib/sendmail -t");
print MESSAGE "To: $mailList\n";
if ($ccList)
{
print MESSAGE "Cc: $ccList\n";
}
if ($bccList)
{
print MESSAGE "Bcc: $bccList\n";
}
print MESSAGE "From: $In{eMail}\n";
print MESSAGE "Reply-to: $In{eMail}\n";
print MESSAGE "Subject: Feedback form info\n\n";
foreach $key (sort keys(%In))
{
print MESSAGE "$key = $In{$key}\n";
}
close (MESSAGE);
}

printSuccess($successPage);

## end main script ##
##################################################################################

sub parse
{
# parse the input from the form
# full stream in $buffer of all form elements
my $buffer;
if ($ENV{REQUEST_METHOD} eq 'GET')
{
$buffer = $ENV{QUERY_STRING};
}
else
{
read(STDIN,$buffer,$ENV{CONTENT_LENGTH});
}
# the ampersand is a special char that splits form elements
# valArray will have the variable / value pairs
my @valArray = split(/&/,$buffer);
# trans special characters and url vars

## perl script cont...
foreach(@valArray)
{
$_ =~ tr/+/ /;
my ($var,$val) = split(/=/,$_,2);
$var =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$val =~ s/(\<.*?)(embed|object|script|applet)(.*?\>)/$1$3/gis;
# put variable and value into associative array (tab separated if key var already exists)
if($In{$var})
{
$In{$var} .= "\t$val";
#print "$var = $In{$var}\n";
}
else
{
$In{$var} = $val;
#print "$var = $In{$var}\n";
}
}
}

sub printTop
{
print header;
print start_html("form submission");
print br();
}

sub printError
{
my ($errMsg, $errPage) = @_;
if ($errPage)
{
print ("Location: $errPage?Err=$errMsg\n\n");
exit;
}
else
{
printTop();
print ("Error!
");
print (@_);
print "\n";
print end_html;
exit;
}
}

sub printSuccess
{
my ($successPage) = @_;
if ($successPage)
{
print ("Location: $successPage\n\n");
exit;
}
else
{
printTop();
print ("Success!");
print end_html;
exit;
}
}

sub printDebug
{
print (@_);
print "\n";
}

## end of script

Boy, that didn't hold the formatting well, did it?
If you want it as a text file with proper indentation and line breaks, you can e-mail me at hunn@lucent.com and I'll send it to you.