mike:miketyson@yahoo.com:123-2323-324 bill:billyong@hotmail.com:434-3213-321 mike:miketyson@yahoo.com:123-2323-324 briney:britney@yahoo.com:343-2322-111 mike:miketyson@yahoo.com:123-2323-324 ##
##

#!/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);
 
}