Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?

comment on

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

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

In reply to Help with my Coding Style - another chance to critique by rattusillegitimus

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 the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others scrutinizing the Monastery: (None)
      As of 2020-12-06 01:18 GMT
      Find Nodes?
        Voting Booth?
        How often do you use taint mode?

        Results (65 votes). Check out past polls.