The 2003 Perl Advent Calendar
[about] | [news] | [rss] | [mirrors] | [links]
[2000] | [2001] | [2002] | [2003] | [2004]

On the 8th day of Advent my True Language brought to me..
CGI::Application

Writing a CGI script is a fairly simple task. All you need to do is pull in some data and print out a correctly formatted data, and the CGI module can handle most of the nitty gritty details of this, like extracting parameters, or printing properly formatted headers, with ease.

So why do most CGI scripts end up as tangled mess? People start off simple, and sooner than they can say 'lickedy split' they've added a feature here, a special case there, and what was a simple linear script is now a complicated nest of conditionals and programing constructs.

The solution is to turn your CGI script into a module. This has numerous advantages, from streamlining your code into easily handled subroutines to allowing you to easily reuse code. It has one major disadvantage though - your CGI routine will now need some flow of control mechanism to decide what method to call on the object to get the output that matches your input.

This is where CGI::Application comes in. I'm tempted to call it a framework for doing this kind of thing, but the term sounds too big and scary. CGI::Application is simple - real simple - but just powerful enough to do the simple task of calling the right method in your class at the right time. It's the kind of tool I like, something that can aid you in making that quick script just that little bit less ad-hoc and prone to bugs with hardly any more effort.

The idea behind a CGI::Application package is that you subclass the CGI::Applicaiton package and define a set of extra methods in that package, each of which should return different HTML in different situation. You then setup the application in such a way that based on the value of a certain CGI parameter - your mode parameter - different methods are called each time the module's run method is called.

Let's write a quick CGI::Application application to convert colour names into triplets as means of demonstration of how this works. A working version of this script is running

  • here
  • .

    We start off by creating a package that inherits from CGI::Applicaiton and turns on the language's safety features:

      package MarksColourApp;
      use base qw(CGI::Application);
      # turn on perl's safety features
      use strict;
      use warnings;

    We then need to do a little setup for the CGI::Application by overriding the default setup method with one that sets up the application how we want it:

      sub setup
      {
         my $self = shift;
         # set the mode we're going to use if no mode is passed 
         # (i.e. it's the first time the script is called
         $self->start_mode('name');
         # set the name of the CGI parameter we're going to use
         # to declare what mode we're in
         $self->mode_param('mode');
         # list all the run modes and what methods should be called
         # for each mode.
         $self->run_modes(
           'name'  => 'name_mode',
           'show'  => 'show_mode',
         );
      }

    So we've named two methods name_mode and show_mode that will be called depending on what the mode cgi parameter is set to. We still need to write these, but before we do, we create a little utility routine that wraps whatever we pass it in HTML markup and returns it:

      use HTML::Entities;
      sub wrap_in_html
      {
        my $self  = shift;
        my $title = encode_entities(shift);
        my $body  = shift;
        # wrap the body and return it
        return <<"."
      <html>
       <head><title>$title</title></head>
       <body>$body</body>
      </html>
      .
      }

    We've not got to create our modes. It doesn't matter which order we write these as they're just methods that are called upon our objects and hence we can define them in any order. Each of these methods should return our output (after passing it through wrap_in_html) rather than printing it out directly. This is because the CGI::Application must have the chance to print out other things before the output we've just handed back to it is printed, such as the CGI header. Let's start with run_mode, which just has to print out a form asking for the name of a colour:

      sub name_mode
      {
         my $self = shift;
         return $self->wrap_in_html("Enter Colour",<<".");
      <h1>Enter Colour<h1>
      <form>
       <input type="hidden" name="mode"   value="show" />
       <input type="text"   name="colour" />
       <input type="submit" name="submit" value="Submit" />
      </from>
      .
      }

    We then need to write our show mode. This does the logical processing and decides what subroutine to call to display the correct HTML depending on if it recognised the colour or not.

      sub show_mode
      {
         my $self = shift;
     
         # get the CGI object
         my $cgi = $self->query;
         # work out what colour name we've been passed.
         my $colour_name = $cgi->param('colour');
         # if we didn't get a colour, just show the name_mode again
         unless ($colour_name)
          { return $self->name_mode() }
         # get the colour for that name, and if we didn't get a
         # colour hex return an error
         my $hex = $self->colour_name_to_hex($colour_name);
         unless ($hex)
          { return $self->no_such_colour_html($colour_name) }
         # just show the normal html for that colour
         return $self->hex_colour_html($colour_name, $hex)
      }
      
      sub no_such_colour_html
      {
        my $self        = shift;
        my $colour_name = encode_entities(shift);
        return $self->wrap_in_html("No Such Colour", <<".");
      <h1>No Such Colour</h1>
      <p>No colour '$colour_name' found.</p>
      <p><a href="?mode=name">re-enter</a></p>
      .
      }
      sub hex_colour_html
      {
        my $self        = shift;
        my $colour_name = encode_entities(shift);
        my $hex         = shift;
        return $self->wrap_in_html("No Such Colour", <<".");
      <h1>Colour Hex</h1>
      Colour '$colour_name' is:
      <table>
       <tr>
        <td bgcolor="#$hex"><font color="white">#$hex</font></td>
        <td bgcolor="#$hex"><font color="black">#$hex</font></td>
       </tr>
      </table>
      <p><a href="?mode=name">re-enter</a></p>
      .
      }

    You can see one of the major advantages of using an application where all stages of the processes are methods straight away in this above code. If show_mode gets called without a colour being filled in at all then we simply return the results of calling name_mode, reshowing the form to give the person another chance to enter. The ability to change our execution path midflow makes error cases much easier to write without making the code too difficult to read.

    The above code used a utility method called colour_name_to_hex to get the hex values for the colour. In this implementation we use the Graphics::ColorNames module to do our dirty work for us.

      use Graphics::ColorNames;
      {
        # create a hash that has mappings for colour names to hex
        # values that only colour_name_to_hex can access (as it's
        # the only routine inside these brackets)
        my %NameTable;
        tie %NameTable, 'Graphics::ColorNames', 'HTML';
        sub colour_name_to_hex
        {
           my $self        = shift;
           my $colour_name = shift;
           return $NameTable{ $colour_name };
        }
      }

    As all Perl modules the module should end in a true value to indicate to perl that it's been loaded okay

      # keep perl happy
      1;

    After all this is written all that is left to do is write the CGI script itself. All this code has to to do is load and execute the module we've just written.

      #!/usr/bin/perl
      
      # turn on perl's safety features
      use strict;
      use warnings;
      # load, instantiate, and execute our application.
      use MarksColourApp;
      my $cgiapp = MarksColourApp->new();
      $cgiapp->run;

    Extending the Application

    Because what we've just written is a module we can create alternate versions of the program by inheriting from the module and overriding methods. For example, in the above code we only recognise the 16 or so HTML colours defined in the CSS spec. If we want to recognise all of the standard 650ish colour names that are commonly used by XWindows we can override the code for the translation routine.

      package MarksXColourApp;
      use base qw(MarksColourApp);
      {
        my %NameTable;
        tie %NameTable, 'Graphics::ColorNames', 'X'; # use all X
        sub colour_name_to_hex
        {
           my $self        = shift;
           my $colour_name = shift;
           return $NameTable{ $colour_name };
        }
      }
      # return true to keep perl happy
      1;

    We obviously have to change the CGI script to load this new module instead of the old one:

      #!/usr/bin/perl
      
      # turn on perl's safety features
      use strict;
      use warnings;
      # load, instantiate, and execute our application.
      use MarksXColourApp;
      my $cgiapp = MarksXColourApp->new();
      $cgiapp->run;

    This code can be seen running

  • here
  • , and you can enter values like 'LimeGreen' which the HTML version will not recognise

  • Using CGI::Application article on perl.com
  • Graphics::ColorNames