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...
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();