Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
Monks-

After reading 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.

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.

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 that 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?

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.

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'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

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

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others examining the Monastery: (6)
As of 2024-03-28 15:08 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found