http://qs321.pair.com?node_id=178766

rattusillegitimus has asked for the wisdom of the Perl Monks concerning the following question:

My fellow monks:

In my former life, I used Perl quite frequently as part of my job, but I've gotten very rusty in my new position in a Microsoft-only environment. Looking for a way to revive my skills, I decided to transform an old website I used to maintain from a proprietary content-management system to a Perl CGI driven dynamic site. Thanks in large part to this Monestary, I think I've come to an understanding of how modules like CGI::Application and DBI work.

Now that I've written much of the basic framework for my module, I would like for your input into where I'm going. It's not by any means complete, but I would like to correct any major errors in the code or my coding practice as soon as I can. I've only included three of the seven run mode subs, as the rest aren't written yet.

Any suggestions on optimization, best/worst practices, security, etc. would be greatly appreciated. This is my first attempt to use either CGI::Application or DBI, so I'm sure I'm making some bone-headed mistakes there. Feel free to rip anything I've done to shreds, that I may rebiuld it to be better than it was before... stronger ... faster ... more fun at parties...

Many thanks in advance,
-rattus, inspired by emilford's Meditation

Here's my package:

package AuthorWeb; use strict; use base 'CGI::Application'; use Date::Calc qw(Date_to_Text_Long); use DBI(); use XML::LibXSLT; use XML::LibXML; sub setup { my $self = shift; $self->tmpl_path('/path/to/my/include/files/'); $self->start_mode('index'); $self->mode_param('rm'); $self->run_modes( 'index' => 'do_index', 'authors' => 'do_authorlist', 'author' => 'do_author', 'bibliography' => 'do_biblio', 'book' => 'do_book', 'searchform' => 'do_search_form', 'search' => 'do_search', 'about' => 'do_about' ); $self->param('dbh' => DBI->connect("DBI:mysql:database=authorweb;hos +t=localhost", "USERNAME", "PASSWORD", {'RaiseError' => 1})); $self->param('dom' => XML::LibXML::Document->createDocument('1.0')); $self->param('xslt' => XML::LibXSLT->new()); } sub teardown { my $self = shift; $self->param('dbh')->disconnect(); } sub do_index { my $self = shift; my $template = $self->load_tmpl('main.html'); my $cgi = $self->query(); $template->param(PAGETITLE => 'Corwin\'s AuthorWeb'); $template->param(PAGEBODYTITLE => 'Corwin\'s AuthorWeb'); $template->param(PAGEBODY => $cgi->p('Pardon the Mess, We are Reinca +rnating')); $template->param(LASTMOD => lastmod()); return $template->output; } sub do_authorlist { my $self = shift; my $template = $self->load_tmpl('main.html'); my $cgi = $self->query(); if ($cgi->param('alpha') =~ /^([A-Za-z]){1}$/) { $self->param('xsl_file' => $self->tmpl_path().'author-list.xsl'); $template->param(PAGETITLE => "Corwin\'s AuthorWeb - $1"); $template->param(PAGEBODYTITLE => "Corwin\'s AuthorWeb - $1"); $cgi->param('alpha' => $1); $self->param('dom' => authorList($self)); $template->param(PAGEBODY => xsl_transform($self)); } else { $template->param(PAGETITLE => 'Corwin\'s AuthorWeb - Error'); $template->param(PAGEBODYTITLE => 'Corwin\'s AuthorWeb - Error'); $template->param(PAGEBODY => $cgi->p('Invalid letter')); } $template->param(LASTMOD => lastmod()); return $template->output; } sub do_author { my $self = shift; my $template = $self->load_tmpl('main.html'); my $cgi = $self->query(); if ($cgi->param('authid') =~ /^(\d{10})$/) { $cgi->param('authid' => $1); $self->param('xsl_file' => $self->tmpl_path().'author.xsl'); $template->param(PAGETITLE => 'Corwin\'s AuthorWeb - Author'); #$template->param(PAGEBODY => authorPage($self)); $self->param('dom' => authorPage($self)); $template->param(PAGEBODY => xsl_transform($self)); } else { $template->param(PAGETITLE => 'Corwin\'s AuthorWeb - Error'); $template->param(PAGEBODYTITLE => 'Corwin\'s AuthorWeb - Error'); $template->param(PAGEBODY => $cgi->p('Invalid Authod ID')); } $template->param(LASTMOD => lastmod()); return $template->output; } sub lastmod { # placeholder sub until I figure out what I want to to for last mod +ified # timestamp my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtim +e(); my $lastmod = Date_to_Text_Long($year+1900,$mon+1,$mday); return $lastmod; } sub authorList { my $self = shift; my $alpha = $self->query()->param('alpha'); my $dbh = $self->param('dbh'); my $dom = $self->param('dom'); my $xslt = $self->param('xslt'); my $root = $dom->createElement('AUTHORS'); my $output; # Query Database my $sql = 'SELECT authid,sub_date,lastname,firstname,middlename,titl +e,suffix FROM authors WHERE lastname like ?;'; my $sth = $dbh->prepare($sql); $sth->execute($alpha.'%'); # Generate XML while (my $ref = $sth->fetchrow_hashref()) { $root->appendChild(make_author_node($dom,$ref)); } $sth->finish; $dom->setDocumentElement($root); return $dom; } sub authorPage { my $self = shift; my $authid = $self->query()->param('authid'); my $dbh = $self->param('dbh'); my $dom = $self->param('dom'); my $parser = $self->param('parser'); my $xslt = $self->param('xslt'); my $root; my $output; # Query Database my $sql = 'SELECT * FROM authors WHERE authid = ?;'; my $sth = $dbh->prepare($sql); $sth->execute($authid); # Generate XML if ($sth->rows > 0) { my $ref = $sth->fetchrow_hashref(); $root = make_author_node($dom,$ref); } $sth->finish; # Get Images $sql = 'SELECT imageid, url, height, width, attribution FROM images +where imagetype=? and authid=?;'; $sth = $dbh->prepare($sql); $sth->execute('author',$authid); while (my $ref = $sth->fetchrow_hashref()) { $root->appendChild(make_image_node($dom,$ref)); } $sth->finish; $dom->setDocumentElement($root); return $dom; } sub xsl_transform { my $self = shift; my $dom = $self->param('dom'); my $xslt = $self->param('xslt'); # Apply XSL Template my $stylesheet = $xslt->parse_stylesheet_file($self->param('xsl_file +')); my $results = $stylesheet->transform($dom); return $stylesheet->output_string($results); } sub make_node { my $dom = shift; my $nname = shift; my $ntext = shift; my $type = shift || 'TEXT'; my $node = $dom->createElement($nname); if ($ntext && $type eq 'TEXT') { $node->appendChild($dom->createTextNode($ntext)); } elsif ($ntext) { $node->appendChild($dom->createCDATASection($ntext)); } return $node; } sub make_author_node { my $dom = shift; my $ref = shift; my $root = $dom->createElement('AUTHOR'); $root->setAttribute('authid',sprintf("%010u",$ref->{'authid'})); $root->setAttribute('created',$ref->{'sub_date'}); if ($ref->{'updated_date'}) { $root->setAttribute('modified',$ref->{'updated_date'}); } my $name = $dom->createElement('NAME'); if ($ref->{'title'}) { $name->appendChild(make_node($dom,'TITLE',$ref->{'title'})); } if ($ref->{'firstname'}) { $name->appendChild(make_node($dom,'FIRST',$ref->{'firstname'})); } if ($ref->{'middlename'}) { $name->appendChild(make_node($dom,'MIDDLE',$ref->{'middlename'})) +; } if ($ref->{'lastname'}) { $name->appendChild(make_node($dom,'LAST',$ref->{'lastname'})); } if ($ref->{'suffix'}) { $name->appendChild(make_node($dom,'SUFFIX',$ref->{'suffix'})); } $root->appendChild($name); $root->appendChild(make_node($dom,'ABOUT',$ref->{'about'},'CDATA')); $root->appendChild(make_node($dom,'CONTACT',$ref->{'contact'})); my $dates = $dom->createElement('DATES'); if ($ref->{'dob'}) { $dates->appendChild(make_node($dom,'BIRTH',$ref->{'dob'})); } if ($ref->{'dod'}) { $dates->appendChild(make_node($dom,'DEATH',$ref->{'dod'})); } $root->appendChild($dates); return $root; } sub make_image_node { my $dom = shift; my $ref = shift; my $root = $dom->createElement('IMAGE'); $root->setAttribute('image',sprintf("%010u",$ref->{'imageid'})); $root->setAttribute('created',$ref->{'sub_date'}); $root->setAttribute('src',$ref->{'url'}); $root->setAttribute('height',$ref->{'height'}); $root->setAttribute('width',$ref->{'width'}); if ($ref->{'attribution'}) { $root->appendChild(make_node($dom,'ATTRIBUTION',$ref->{'attributi +on'})); } return $root; } 1;

For the sake of completeness, here's my actual CGI script:

#!/usr/bin/perl -wT use strict; use lib qw ( /path/to/my/modules ); use AuthorWeb; my $webapp = AuthorWeb->new(); $webapp->run();

Replies are listed 'Best First'.
Re: Help with my Coding Style - another chance to critique
by belg4mit (Prior) on Jul 02, 2002 at 06:40 UTC
    It's far from the worse code I've seen ;-) Seriously it's not bad. There are a few minor nits here and there.
    use Date::Calc qw(Date_to_Text_Long);
    qw is unnecessary for a single element, and inconsistent with line 3
    use DBI();
    do you really mean a null import list? it would also perhaps be better to insert whitespace between DBI and the parens. (I did say these were nits ;-)
    $self->tmpl_path('/path/to/my/include/files/');
    Use of ' for things that needn't be interpolated is a good habit.
    'index' => 'do_index',
    keys of \w+ don't need to be quoted with =>
    $self->param('dbh' => DBI->connect("DBI:mysql:database=authorweb;host=localhost",
    You might look at DBIx::Connect.
    if ($cgi->param('alpha') =~ /^(A-Za-z){1}$/)
    the {1} is meaningless here
    " "
    This might be a good place for a dispatch table or mock switch statement, especially if you might add functionality in the future.
    'Corwin\'s AuthorWeb'
    This is unnecessarily repeated, you might consider setting it up in a package global or constant?
    my is somewhat expensive
    You might consider grouping all of them at a head of the block eg; my($foo, $bar) The difference is rather small (4% for 4 scalars in my tests) but could make a difference on high traffic site. As a matter of taste it might be prefertial to see all of the variables of a block in one location.
    my $ref = $sth->fetchrow_hashref();
    I would instead immediately pass the fetch result directly to your sub, this would also allow you to collapse the entire if statement into one lie. either foo if bar or bar && foo
    $_
    There are several places you could take advantage of $_, but this is personal preference, I happen to like dense code.
    if ($ref->{'dob'})
    thse kind of things often look and read (as English) better as a single line of code like the previous if.

    --
    perl -pew "s/\b;([mnst])/'$1/g"

        Rat is, my point is that several params are being given the same substr. Having this substr be stored in one place would make it easier to update, etc.

        --
        perl -pew "s/\b;([mnst])/'$1/g"

Re: Help with my Coding Style - another chance to critique
by crazyinsomniac (Prior) on Jul 02, 2002 at 07:05 UTC
Re: Help with my Coding Style - another chance to critique
by samtregar (Abbot) on Jul 02, 2002 at 07:05 UTC
    I'll admit that I didn't take the time to read through your code carefully, but right off the bat I see two problems:

    • No comments
    • No POD documentation

    Commenting will help you understand your code better, now and when you return to it in a year. POD will help other programmers use your modules. In the case of a CGI::Application module the POD is a good place to put an example stub and describe any configuration parameters (PARAMS) you support.

    -sam

      These are not prerequisites for good programs, this code is quite self-explanatory without them. This is my own reaction of course, from someone who comments very little. To each is own.

      --
      perl -pew "s/\b;([mnst])/'$1/g"

        No code is self-explantaory! Code only says "how." Good code can also explain "what." It is generally impossible for code, no matter how good, to properly document "why." The "why" of a program is crucial to maintainability, which is a critical property of good programs. A good program that is hard for others to maintain isn't really very good given time.

        -sam

Re: Help with my Coding Style - another chance to critique
by FoxtrotUniform (Prior) on Jul 02, 2002 at 05:46 UTC

    I'm not really well-versed in Perl CGI programming, so I don't have a hell of a lot to say. I like the fact that your routines are fairly short, and that your symbol names are well-chosen. My biggest complaint is that you don't tend to line up like tokens vertically (most noticeable in the $self->run_modes call in sub setup), but that's a minor issue. I'd be tempted to break up some of the longer subroutines even more, but that's just me.

    --
    The hell with paco, vote for Erudil!
    :wq

      Thanks for the input. The tokens not lining up is mainly because I changed all my tabs to spaces before posting to keep the lines from wrapping quite as much. I'll go through the original source, though, and make sure everything is lined up as it should.

      I would be quite interested in seeing any suggestions you have for breaking up some of the longer routines.

      -rattus

Re: Help with my Coding Style - another chance to critique
by rattusillegitimus (Friar) on Jul 03, 2002 at 05:52 UTC

    Thanks for the great pointers. I'm already incorporating several of them. Im reading up on the DBIx::Connect, DBI::DWIW, and AxKit modules to see what I might like to grab, and I'll be reading all the module documentation I can get my hands on to learn more about subclassing.

    Most importantly, I agree whole-heartedly with samtregar's suggestion about comments and documentation. I'm having a terrible time figuring out why I set up the original version of this website the way I did, to the point of not even knowing what a couple of my database fields are for. I'm flattered, belg4mit, that you found my code so easy to read, but I don't want to come back in another year and wonder what the heck I was thinking when I set things up this way. ;)

    Thanks again, Monks. Now off to become one with perlpod

    Update: edited AxKit link