perlmeditation
emilford
Monks-<br><br>
After reading [Mr Muskrat|Mr. Muskrat's] post on good programming practices, [Some advice on another's scripts], my eye grew more critical of my current Perl programming style.<br><br>
I've been learning to program for about 5 years, with only about a year in Perl. I just graduated college, so I haven't had any real professional experience, just what I was taught in school (primarily C/C++). Perl I learned on my own and modeled my style after my C/C++ knowledge and the books that I learned from.<br><br>
I've been re-writing most of the scripts, trying to improve them as much as possible. My knowledge of Perl has greatly increased since I initially wrote these, so I realized just how terribly written they were (hopefully they still aren't <b>that</b> bad :-P). I've been able to critique myself to a certain extent (minize globals, use strict, -w), but now I'm looking for critique from the gurus. What better way to learn, right?<br><br>
Here is an example of my code; bash/critique away. Don't worry about hurting my feelings, if something is terribly done, I want to know, so that I won't do it again and improve my programming. If you have a suggestion, post it. If I like the suggestion, I'll use it. I may, however, prefer my own method. Either way, it's good to know.<br><br>
First, let me point something out. I already know one huge mistake in the code below: not using CGI.pm. While some feel that this is a matter of preference, I've been working through [Ovid|Ovid's] tutorial on CGI to learn to use this method. This includes taint and other security issues, so I'll be improving my code there. Anything else you guys can comment on, go for it! TIA - Eric
<P>Code follows:</P>
<READMORE>
<code>
#!/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);
}
</code>
<p><small><b>Edited</b>: ~Wed Jun 26 21:02:39 2002 (GMT),
by [Footpad]:<br />Actions: Added <READMORE> tag</small></p>