Perl Beginners - Addressbook Tutorial Step 4

Perl Beginners - Addressbook Tutorial Step 4 - The Perl Handler

In Step 3, we created a Perl base class. From now on, I won't explain similar lines of code that have been previously described.

So now we need a Perl handler. The handler will be a class that contains methods the cgi calls, passes an argument list, processes the request, prepares output, and sends the output to the browser . In our cgi, we called the following methods:

new

required_parameters

$action (this method will change depending on what the cgi is asked to do)

sendoutput

So, at a minimum, our Perl handler will need to have these methods. Additionally, here are some other things our Perl handler should do:

get a handle to the database;

store an HTML::Template hash for the output;

specify which HTML::Template file the output will be sent to;

set the HTML::Template root directory;

convert the argument list that's passed in into a hash;

verify the argument hash contains all required parameters necessary for the requested action; and

destroy the database handle when finished sending the output to the browser (or crashing due to an error).

Also, we'll add a way to put the code into debug mode, which will add descriptive messages to the httpd error log (this is also known as a hook).

Here's the code for Handler.pm (NOTE: the Perl motto is "There's more than one way to do it". Please do not think the code I provide is the only way!):


  package PEACE::AddressBook::Handler;
  # /usr/lib/perl5/5.6.0/PEACE/AddressBook/Handler.pm - handles actions called by the cgi for addressbook

  require 5.6.0;
  use strict;
  use base qw(PEACE::AddressBook);
  use Carp;
  use DBI ();
  use HTML::Template;

  our $VERSION = do { my @r = (q$Revision: 1.1.1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
  # must be all on one line, for MakeMaker

  #my $debug = 0;
  my $debug = 1;
  use Data::Dumper;

  {
    my %REQUIRED_PARAMS = (
      start             => {}
    );

    sub required_parameters {
      my ($self) = @_;
      return $REQUIRED_PARAMS{$self->_action};
    }
  }

  sub new {
    my ($class, %args) = @_;

    for (qw{ action cgi }) { croak "missing $_ arg" unless defined $args{$_}; }

    my $self = bless {
      _ACTION     => $args{action},
      _DB         => DBI->connect(@PEACE::AddressBook::DBI_CONNECT_ARGS),
      _TEMPLATE   => {},
      _TFILE      => '',
      _CGI        => $args{cgi}
    }, $class;

    $ENV{HTML_TEMPLATE_ROOT} = $PEACE::AddressBook::HTML_TEMPLATE_ROOT;

    if ($debug) {
      my @t = localtime(time);
      warn "NEW->",
        sprintf('%02d:%02d:%02d %02d.%02d.%04d', $t[2], $t[1], $t[0], $t[4]+1, $t[3], $t[5]+1900),
        "\n"
    }
    return $self;
  }

  sub sendoutput {
    my ($self) = @_;
    warn "sending output to ", Dumper($self->_tfile), "\n" if $debug;
    warn "output: ", Dumper($self->_template), "\n" if $debug;
    my $template = HTML::Template->new(filename => $self->_tfile);
    $template->param(%{$self->_template});
    print $template->output;
  }

  # internal accessors
  sub _action { shift->{_ACTION} };
  sub _db { shift->{_DB} };
  sub _template { shift->{_TEMPLATE} };
  sub _tfile { shift->{_TFILE} };
  sub _cgi { shift->{_CGI} };

  sub _get_args {
    my ($self, @args) = @_;
    my $args = {};

    while (my ($name, $value) = splice(@args, 0, 2)) {
      push @{ $args->{$name} }, $value;
    }

    while (my ($name, $value) = each %$args) {
      unless (scalar(@$value) > 1) {
        $args->{$name} = $value->[0];
      }
    }
    warn "args are: ", Dumper($args), "\n" if $debug;
    return $args;
  }

  sub _check_args {
    my ($self, $args) = @_;

    my $req_args = $self->required_parameters();
    warn "checking for action " . Dumper($self->_action) . "\n" if $debug;
    my $err_log = '';

    foreach (keys(%$req_args)) {
      $err_log .= "<b>Missing required field:</b> <i>$req_args->{$_}[2]<br></i>" 
        if $req_args->{$_}[0] && (!(defined $args->{$_}));
      $err_log .= "<b>Bad length:</b> 
        <i>$req_args->{$_}[2]</i> must be at least $req_args->{$_}[1] character(s)<br>"
        if (defined $args->{$_} && length($args->{$_}) < $req_args->{$_}[1]);
    }
    warn "error log: ", Dumper($err_log) if $debug && $err_log;
    return $err_log;
  }

  sub DESTROY {
    my ($self) = @_;
    $self->_db->disconnect();
  }

  1;
  __END__

Now, although this may look complicated, it really isn't. Let's examine each section of this code.


  use base qw(PEACE::AddressBook);
  use Carp;
  use DBI ();
  use HTML::Template;

use base tells Perl that PEACE::AddressBook is the base class for this handler. This will make all variables we declared using our available to the handler. Carp provides a function, croak, that works like die does - raising an exception - but gives caller-relative information¹. DBI is the module we'll use to interact with the database. HTML::Template provides a way to separate the Perl code from the HTML (see the Introduction for why I choose to use HTML::Template).


  #my $debug = 0;
  my $debug = 1;
  use Data::Dumper;

Here we provide the hook, described earlier. While in development, we'll leave the $debug variable set to TRUE. Data::Dumper is a class that formats variables and references so the values can be easily read. It's pretty cool, it'll even put the word 'undef' in when a variable is not defined. I highly recommend using this class instead of using print when you're interested in viewing a particular variable or reference.


  {
    my %REQUIRED_PARAMS = (
      start             => {}
    );

    sub required_parameters {
      my ($self) = @_;
      return $REQUIRED_PARAMS{$self->_action};
    }
  }

%REQUIRED_PARAMETERS is a hash that contains actions as its keys, and references to hashes that will correspond to the parameter keys we'll be looking for. For now, the only action we have is start, but later we'll be adding more actions to this hash. The required_parameters subroutine simply returns the portion of the %REQUIRED_PARAMETERS hash that we're interested in examining. The block is arranged in this way to give it closure. Closure gives us a way to set values used in a subroutine when you define it, not just when you call it².


  sub new {
    my ($class, %args) = @_;

    for (qw{ action cgi }) { croak "missing $_ arg" unless defined $args{$_}; }

    my $self = bless {
      _ACTION     => $args{action},
      _DB         => DBI->connect(@PEACE::AddressBook::DBI_CONNECT_ARGS),
      _TEMPLATE   => {},
      _TFILE      => '',
      _CGI        => $args{cgi}
    }, $class;

    $ENV{HTML_TEMPLATE_ROOT} = $PEACE::AddressBook::HTML_TEMPLATE_ROOT;

    if ($debug) {
      my @t = localtime(time);
      warn "NEW->",
        sprintf('%02d:%02d:%02d %02d.%02d.%04d', $t[2], $t[1], $t[0], $t[4]+1, $t[3], $t[5]+1900),
        "\n"
    }
    return $self;
  }

new is this class's constructor. A constructor is a method that creates and returns a reference to an object (yes, this is object-oriented programming). First, we read in the $class and argument hash (the argument hash is what's passed in from the cgi). Then, we check to make sure we've passed in hash keys called 'action' and 'cgi' that have defined values. We can't really call an action method without knowing what the action is, can we? And we won't be able to read any CGI parameters without getting the reference to the CGI object (which was defined in the cgi). Next, we declare a $self variable, which blesses a hash reference and the class. bless takes an ordinary referent and turns it into an object. It's basically a way to say this: "Take these variables (the hash ref), and make them available to the entire class (as a reference called $self)." Type perldoc -f bless to find out more about the bless function.

Each key value of the blessed hash corresponds to a variable that's necessary for each method of the class to work. _ACTION is set to the action, _DB is a handle to the database (notice we're calling the arguments defined in the base class), _TEMPLATE is an empty hash reference (it will be filled in later by an action method), _TFILE is the name of the HTML::Template file we'll use for the output, currently set to NULL (it will be set by each action method), and _CGI is the reference to the CGI object passed in from the cgi.

Next, we set the HTML::Template root directory. This is the directory where we'll be storing our template files. HTML::Template will look for this environment variable when we tell it to send the output to a particular filename. Again notice we're using a variable defined in the base class. Next, I like to add a NEW line to the httpd error log to delimit each time we access this class (this makes it easier to find any statements in the log). Finally, the constructor returns the blessed $self hash reference (which is now an object).


  sub sendoutput {
    my ($self) = @_;
    warn "sending output to ", Dumper($self->_tfile), "\n" if $debug;
    warn "output: ", Dumper($self->_template), "\n" if $debug;
    my $template = HTML::Template->new(filename => $self->_tfile);
    $template->param(%{$self->_template});
    print $template->output;
  }

The sendoutput method puts the HTML::Template filename for the output and the reference to the variables in the httpd error log (when in debug mode). Then, it sets up the parameters for the output, and finally prints the output. Read perldoc HTML::Template for more information about these methods.


  # internal accessors
  sub _action { shift->{_ACTION} };
  sub _db { shift->{_DB} };
  sub _template { shift->{_TEMPLATE} };
  sub _tfile { shift->{_TFILE} };
  sub _cgi { shift->{_CGI} };

Here we provide methods to access values of the blessed hash reference. We can set these values by calling them directly (ie.- $self->{_TFILE} = 'somefile.tmpl';), but to get the values we call the corresponding internal accessor (ie.- my $filename = $self->_tfile;).


  sub _get_args {
    my ($self, @args) = @_;
    my $args = {};

    while (my ($name, $value) = splice(@args, 0, 2)) {
      push @{ $args->{$name} }, $value;
    }

    while (my ($name, $value) = each %$args) {
      unless (scalar(@$value) > 1) {
        $args->{$name} = $value->[0];
      }
    }
    warn "args are: ", Dumper($args), "\n" if $debug;
    return $args;
  }

_get_args is an internal method (as denoted by the leading '_') that basically takes the argument array passed to the action method and puts the arguments into a hash. For example, consider the following URL:


  /cgi-bin/handler.cgi?action=search&record_id=123&someothervariable=abcde

In this case, the array passed into the method contains the values 'record_id', '123', 'someothervariable', 'abcde'. The _get_args method takes this array and returns a reference to a hash that looks like this:


  {
    record_id         => 123,
    someothervariable => 'abcde' 
  }

If the URL looked like this:


  /cgi-bin/handler.cgi?action=search&record_id=123&record_id=321&record_id=231&someothervariable=abcde

then the hash reference would be:


  {
    record_id         => [123, 321, 231], 
    someothervariable => 'abcde'
  }


  sub _check_args {
    my ($self, $args) = @_;

    my $req_args = $self->required_parameters();
    warn "checking for action " . Dumper($self->_action) . "\n" if $debug;
    my $err_log = '';

    foreach (keys(%$req_args)) {
      $err_log .= "<b>Missing required field:</b> <i>$req_args->{$_}[2]<br></i>"
        if $req_args->{$_}[0] && (!(defined $args->{$_}));
      $err_log .= "<b>Bad length:</b>
        <i>$req_args->{$_}[2]</i> must be at least $req_args->{$_}[1] character(s)<br>"
        if (defined $args->{$_} && length($args->{$_}) < $req_args->{$_}[1]);
    }
    warn "error log: ", Dumper($err_log) if $debug && $err_log;
    return $err_log;
  }

_check_args is an internal method that checks the arguments in the hash created by _get_args and verifies them against what is in the %REQUIRED_PARAMETERS hash discussed earlier. We'll save further explanation of this method for later, when we add values to %REQUIRED_PARAMETERS.


  sub DESTROY {
    my ($self) = @_;
    $self->_db->disconnect();
  }

Any DESTROY method is called when an object reference goes out of scope or when an exception is raised. We put the disconnect call in here to guarantee the database handle is trashed no matter how we exit out of the class.

We still have not written the start method, which is necessary for the cgi to function (it should compile after writing this class, but will not execute). Also, we have not written the HTML::Template file that will hold the HTML to be displayed. Both come in the next step.

Coming next - Adding the start method and our first HTML::Template file.

1 - Wall, Larry, et. al. (2000). Programming Perl, 3rd Edition. Sebastopol, CA: O'Reilly & Associates, Inc., p. 878.
2 - Ibid, p. 260.