#!/usr/bin/perl -w
use strict;

#-------------------------------------------------------------------------------#
#  Variables
#-------------------------------------------------------------------------------#

# These variables may be modified as needed
my $redirect = "http://www.yoursite.com";	# where to redirect after form submission
my $sendmail = "/usr/sbin/sendmail";					# location of sendmail program
my $subject = "Form Submission Results";					# subject line for email sent - can also be sent as CGI parameter
my @recipients = qw/webmaster@yoursite.com/;				# email address to send the email to
my @required = ();								# comma seperated list of all required fields - can also be sent as CGI parameter

# These variables should not need to be changed
my (%formdata, $current_date, $remote_host, $remote_addr, $server_name);



#-------------------------------------------------------------------------------#
#  Main
#-------------------------------------------------------------------------------#

    &parse_form (\%formdata);
    &set_variables (\%formdata, \@required, \$redirect, \$sendmail, \$subject, \@recipients);
    &check_variables ($redirect, $sendmail, \@recipients);
    &check_required (\%formdata, \@required);
    &get_data (\$current_date, \$remote_host, \$remote_addr, \$server_name);
    &send_email (\%formdata, \@recipients, $sendmail, $subject, $current_date, $remote_host, $remote_addr, $server_name);
    &redirect($redirect);
  


#-------------------------------------------------------------------------------#
#  Subroutines
#-------------------------------------------------------------------------------#

# gets the parameters sent via CGI and stores them in the %formdata hash
sub parse_form {

my ($formdata) = @_;
my (@pairs, $buffer, $value, $key, $pair);

    if ($ENV{'REQUEST_METHOD'} eq 'GET') {
	@pairs = split(/&/, $ENV{'QUERY_STRING'});
    }
    elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
	read (STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
	@pairs = split(/&/, $buffer);
    }
    else {
	print "Content-type: text/html\n\n";
	print "<P>Use Post or Get";
    }

    foreach $pair (@pairs) {
	($key, $value) = split (/=/, $pair);
	$key =~ tr/+/ /;
	$key =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$value =~ tr/+/ /;
	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	
	$value =~s/<!--(.|\n)*-->//g;
	
	if ($$formdata{$key}) {
		$$formdata{$key} .= ", $value";
	}
	else {
		$$formdata{$key} = $value;
	}
    }
    
}

sub set_variables {

my ($formdata, $required, $redirect, $sendmail, $subject, $recipients) = @_;

    @$required = split /,/, $$formdata{'required'} unless ($$formdata{'required'} eq "");
    $$redirect = $$formdata{'redirect'} unless ($$formdata{'required'} eq "");
    $$sendmail = $$formdata{'sendmail'} unless ($$formdata{'sendmail'} eq "");
    $$subject = $$formdata{'subject'} unless ($$formdata{'subject'} eq "");
    @$recipients = split /,/, $$formdata{'recipient'} unless ($$formdata{'recipient'} eq "");

}    

sub check_variables {

my ($redirect, $sendmail, $recipients) = @_;
my $error_message = "";

    # check the redirect link
    $error_message .= "<li>redirect link does not appear to be valid</li>" unless ($redirect =~ m!^http://(www.)?\w+\.\w\w(\w)?(.*)$!);
    
    # verify sendmail will open
    open (MAIL, "|$sendmail -t") or die &show_errors ("Unable to open $sendmail: $!", 0);
    
    # verfity the recipient is valid
    foreach (@$recipients) {										   
        $error_message .= "<li>$_ is not a valid address </li>" unless ($_ =~ /^[_a-z0-9.-]+\@[_a-z0-9.-]*\.\w\w(\w)?$/i);
    }    

    # show the errors if there are any
    &show_errors ($error_message, 0) unless $error_message eq "";

    # close the MAIL program - not needed currently
    close (MAIL);

}

sub check_required {

my ($formdata, $required) = @_;
my $error_message = "";

    # check each field in the array
    foreach (@$required) {
	$error_message .= "<li>$_ is a required field</li>" if $$formdata{$_} eq "";
    }

    # show any error messages
    &show_errors ($error_message, 1) unless $error_message eq "";

}

sub get_data {

my ($current_date, $remote_host, $remote_addr, $server_name) = @_;
my ($year, $month, $day);
my @months = qw/January February March April May June July August September October November December/;

    # get the current date
    ($day, $month, $year) = (localtime)[3,4,5];
    $year += 1900;
    $$current_date = "$months[$month] $day, $year";

    # get the information about who submitted the form
    $$remote_host = $ENV{'REMOTE_HOST'};
    $$remote_addr = $ENV{'REMOTE_ADDR'};
    $$server_name = $ENV{'SERVER_NAME'};

}

sub send_email {

my ($formdata, $recipients, $sendmail, $subject, $current_date, $remote_host, $remote_addr, $server_name) = @_;
my $message = "
------------------------------------------------------
End of Form Submission Results
------------------------------------------------------
";

    # remove unwanted data from formdata
    delete $$formdata{'recipient'};
    delete $$formdata{'subject'};
    delete $$formdata{'required'};
    delete $$formdata{'redirect'};
    delete $$formdata{'sendmail'};

    foreach my $send_to (@$recipients) {
	open (MAIL, "|$sendmail -t") or die &show_errors ("Unable to open $sendmail: $!", 0);
	print MAIL "To: $send_to \nFrom: webmaster\@yoursite.com\n";
	print MAIL "Subject: $subject\n";
	print MAIL "Form Submission Results\n";
	print MAIL "(c) Eric Milford - submit_form.pl\n";
	print MAIL "http://www.yoursite.com\n\n";
	print MAIL "------------------------------------------------------\n";
	print MAIL "[Date Sent] - $current_date\n";
	print MAIL "[Remote Host] - $remote_host\n";
	print MAIL "[Remote Address] - $remote_addr\n";
	print MAIL "[Server Name] - $server_name\n";
	print MAIL "------------------------------------------------------\n\n";
	foreach my $key (keys %$formdata) {
	    print MAIL "$key: $$formdata{$key}\n\n" unless $$formdata{$key} eq "";
	}
	print MAIL $message;
	close (MAIL) or die &show_errors ("Unable to close $sendmail: $!", 0);
    }

}

# redirects the user to the updated index page - or wherever specified
sub redirect {

use CGI qw(:cgi);

my $url = $_[0];
my $q = CGI->new();

  print $q->redirect(
                   -url    => $url
                  );

}
  
sub show_errors {

my ($error_message, $method) = @_;

    $method = "<font face=verdana size=1>An error with the script's installation has occured.
	    Please contact the webmaster with the error messages listed below!" if $method == 0;

    $method = "<font face=verdana size=1>An error occured with your submission.  Please
	    check the errors and make any necessary modficiations!</font>" if $method == 1;

    print "Content-type: text/html\n\n";
    print "<table width=400 border=0 cellpadding=5 cellspacing=5 align=center bgcolor=EEEEEE>\n";
    print "<tr><td align=center width=100%><font face=verdana color=#555555 size=1><b>There was unfortunately a problem</b></font></td></tr>\n";
    print "<tr><td>$method<br><br>";
    print "<ul><font face=verdana size=1>$error_message</font></ul>";
    print "</td></tr></table>\n";

    exit(0);

}