Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

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 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 = ""; # 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/; # 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\\n"; print MAIL "Subject: $subject\n"; print MAIL "Form Submission Results\n"; print MAIL "(c) Eric Milford -\n"; print MAIL "\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

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

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others chanting in the Monastery: (7)
    As of 2017-05-26 17:59 GMT
    Find Nodes?
      Voting Booth?