#!/opt/WWW/tools/perl5/perl
#
# Location of Mail Program
$mailprog = '/usr/lib/sendmail';
# Location where database file will be kept
# This directory must be 777
$datadir = "/webhome/Britney/cgi-bin/Data/";
$url = "http://webhome.ebay/Britney/";
unless ($ENV{'HTTP_REFERER'} =~ /$url/) {
print "Location: $ENV{'HTTP_REFERER'}\n\n";
exit(0);
}
# Parse input form data
&parse_form(\%DATA);
# If env_report is not empty, save/send those too
if ($DATA{'param_env_report'}) {
$DATA{'param_env_report'} =~ s/\s//g;
@ENV = split(/\,/,$DATA{'param_env_report'});
foreach (@ENV) {
$DATA{$_} = $ENV{$_};
}
}
# First check to make sure that all fields are filled
if ($DATA{'param_required'}) {
&check_required(\%DATA);
}
# Send E-mail to All recipients
if ($DATA{'param_recipient'}) {
$DATA{'param_recipient'} =~ s/\s//g;
@recipient = split(/\,/,$DATA{'param_recipient'});
foreach (@recipient) {
&send_mail($mailprog,$_,\%DATA);
}
}
# Check to make sure that database exists
if ($DATA{'param_database'}) {
&add_database("$datadir/$DATA{'param_database'}",\%DATA);
}
# If 'redirect' is not null, then redirect to the page
if ($DATA{'param_redirect'}) {
print "Location: $DATA{'param_redirect'}\n\n";
}
else {
&print_thankyou(\%DATA);
}
exit(0);
###
### subroutine check_required
###
###
sub check_required {
my($r_DATA) = @_;
my(@required, @ERROR);
@required = split(",",$r_DATA->{'param_required'});
foreach (@required) {
if ($r_DATA->{$_} eq "") {
push(@ERROR, $_);
}
}
if (@ERROR) {
print "Content-type: text/html\n\n";
print qq~
Thank you but...
Thank you for taking the time to fill out this form.
However, you didn't complete our form. Please go back and
complete the following fields
~;
foreach (@ERROR) {
print "
$_";
}
print qq~
~;
exit(0);
}
}
###
### subroutine print_thankyou
###
sub print_thankyou {
my($r_DATA) = @_;
print "Content-type: text/html\n\n";
print qq~
Thank you!
Thank you for taking the time to fill out this form.
Here is what you submitted...
~;
if ($r_DATA->{'param_order'}) {
$r_DATA->{'param_order'} =~ s/\s//g;
my @order = split(/\,/,$r_DATA->{'param_order'});
foreach (@order) {
print "
$_: $r_DATA->{$_}";
}
}
else {
foreach (keys %$r_DATA) {
unless ($_ =~ /^param/) {
print "$_: $r_DATA->{$_}";
}
}
}
print qq~
~;
}
###
###
### subroutine add_database
###
sub add_database {
my($file,$r_DATA) = @_;
my($data_in);
# First check and make sure the file exists
if (!(-e "$file")) {
foreach (keys %$r_DATA) {
unless ($_ =~ /^param/) {
$data_in .= "$_|";
}
}
chop($data_in);
open(DATA,">$file") || die $!;
print DATA "$data_in\n";
close(DATA);
}
$data_in = "";
if ($r_DATA->{'param_order'}) {
$r_DATA->{'param_order'} =~ s/\s//g;
my @order = split(/\,/,$r_DATA->{'param_order'});
foreach (@order) {
$r_DATA->{$_} =~ s/\cM//g;
$r_DATA->{$_} =~ s/\n\n//g;
$r_DATA->{$_} =~ s/\n//g;
$r_DATA->{$_} =~ s/\|//g;
$data_in .= "$r_DATA->{$_}|";
}
}
else {
foreach (keys %$r_DATA) {
unless ($_ =~ /^param/) {
$r_DATA->{$_} =~ s/\cM//g;
$r_DATA->{$_} =~ s/\n\n//g;
$r_DATA->{$_} =~ s/\n//g;
$r_DATA->{$_} =~ s/\|//g;
$data_in .= "$r_DATA->{$_}|";
}
}
}
chop($data_in);
open(DATA,">>$file") || die $!;
print DATA "$data_in\n";
close(DATA);
}
###
### subroutine parse_form
###
sub parse_form {
my($r_DATA) = @_;
# Determine request method - take GET and POST Method
if ($ENV{'REQUEST_METHOD'} eq "GET") {
$query_string = $ENV{'QUERY_STRING'};
}
elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN, $query_string, $ENV{'CONTENT_LENGTH'});
}
# Split the name-value pairs
# Remembering that ampersand sign is our "delimiter"
my @pairs = split(/&/, $query_string);
# For each key-value pairs
foreach (@pairs) {
# Split name and value pair ...
# Remembering that name (key) and value are separated by an equal sign
($name, $value) = split(/=/, $_);
# Un-Webify plus signs and %-encoding
# Replaces "+" by a blank space
$name =~ tr/+/ /;
$value =~ tr/+/ /;
# Remove all unwanted tags
$value =~ s//>/g;
$value =~ s/\cM//g;
$value =~ s/\n\n//g;
$value =~ s/\n/
/g;
#Remove all HTML tags
$value =~ s/<([^>]|\n)*>//g;
# Replace Hexadecimal value to its equivalent character value
# Hexadecimal values begin with "%" sign
# Take any two alpha-numeric characters and convert it to its ASCII equivalent
# e option evaluates the second part of the substitude command
# The pack command takes the hex value stored in $1 and converts to an ASCII equivalent
# g option replaces them globally
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# Assign to associative array FORM
# Use "\0" to join any multiple values
if (defined($r_DATA->{$name})) {
$r_DATA->{$name} = join("\0",$r_DATA->{$name},$value);
}
else {
$r_DATA->{$name} = $value;
}
}
return $r_DATA;
}
####
#### subroutine send_mail
####
sub send_mail {
my ($mailprog,$recipient,$r_DATA) = @_;
# Open The Mail Program
open(MAIL,"|$mailprog -t");
print MAIL "To: $recipient\n";
print MAIL "From: $r_DATA->{'EMail'}\n";
if ($r_DATA->{'param_subject'}) {
print MAIL "Subject: $r_DATA->{'param_subject'}\n\n";
} else {
print MAIL "Subject: Phone Update\n\n";
}
print MAIL "Phone Update from \"$r_DATA->{'param_subject'}\" form.\n";
print MAIL "----------------------------------------------------------------\n\n";
if ($r_DATA->{'param_order'}) {
$r_DATA->{'param_order'} =~ s/\s//g;
my @order = split(/\,/,$r_DATA->{'param_order'});
foreach (@order) {
print MAIL ("$_:","","$r_DATA->{$_}\n");
}
}
else {
foreach (keys %$r_DATA) {
unless ($_ =~ /^param/) {
print MAIL ("$_:","","$r_DATA->{$_}\n");
}
}
}
close (MAIL);
}