Code follows:
#!/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 ad +dress to send the email to my @required = (); # comma seperated li +st 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, $curre +nt_date, $remote_host, $remote_addr, $server_name); &redirect($redirect); #--------------------------------------------------------------------- +----------# # Subroutines #--------------------------------------------------------------------- +----------# # gets the parameters sent via CGI and stores them in the %formdata ha +sh 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 ($$formda +ta{'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 Sept +ember 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, $remot +e_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 in +stallation has occured. Please contact the webmaster with the error messages listed be +low!" if $method == 0; $method = "<font face=verdana size=1>An error occured with your su +bmission. 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=#5 +55555 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); }
Edited: ~Wed Jun 26 21:02:39 2002 (GMT),
by Footpad:
Actions: Added <READMORE> tag
In reply to Some suggestions on coding style - a chance to critique by emilford
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |