The first implementation shows a simple all-in-one CGI script that gets the job done quickly and easily. Following that, we'll look at how it can be adapted into a Template Toolkit plug-in and subsequently deployed under mod_perl.

Here's how the CGI script begins:

#!/usr/bin/perl
#
# hangman1.pl
#
# This variation of the classic hangman game implements
# the game logic at the start of the CGI script to
# define a game state.  It then processes an all-in-one
# template to generate the HTML page.
#
# The 'state' variable maintains the state of the game.
# It contains the following:
#   word     => the unknown word
#   guessed  => list of the guessed letters
#   gameno   => the number of words the user has tried
#   won      => the number of times the user guessed correctly
#   total    => the total number of incorrect guesses
#   left     => the number of tries the user has left on this turn
#

use IO::File ( );
use CGI qw(:standard);
use Template;

use strict;
use constant URL   => '/cgi-bin/hangman1.pl';
use constant ICONS => '/icons/hangman';
use constant WORDS => '/usr/games/hangman-words';
use constant TRIES => 6;

Nothing too taxing here. We provide some sensible comments, load the Perl modules we're going to use (including the Template module, of course), and define some constants.

Next comes the core application logic:

# retrieve the state
my $state = get_state( );

# reinitialize if we need to
$state = initialize($state) if !$state or param('restart');

# process the current guess, if any
my ($message, $status) = process_guess(param('guess') || '', $state );

We first call the get_state( )subroutine to restore any current game state from the CGI parameters. We'll see the definition of that subroutine a little later. For now, all we need to know is that it might return undef, indicating that there isn't any current state. In this case, or if the restart CGI parameter is set, we need to call initialize( ) to set the state to contain some sensible starting values.

Then we call process_guess( ) to process any pending guess. We pass the value of the guess CGI parameter or an empty string if not defined, and also a reference to the $state hash array. The subroutine returns a message and a status value that indicates the current state of play.

Now that we've got the application processing out of the way, we can set about generating some output. To do this, we create a Template object and call its process( ) method, specifying a template to process and a hash reference containing template variables:

# create a Template object
my $tt = Template->new( );

# define Template variables
my $vars = {
    url     => URL,
    icons   => ICONS,
    tries   => TRIES,
    title   => 'Template Toolkit Hangman #1',
    state   => $state,
    status  => $status,
    message => $message,
    wordmap => \&wordmap,
};

# process the main template at the end of this file
$tt->process(*DATA, $vars) || die $tt->error( );

In this example we're going to define the main template in the __DATA__section of the CGI script itself. The Template process( ) methods allows a file handle such as *DATA to be specified in place of a template name and will read the content and process it accordingly. Doing this allows us to separate the game logic written in Perl from the presentation template that generates the HTML page, with the benefit of being able to keep everything self-contained in a single file.

That's the main body of the Perl code. Before we look at the template defined at the end of the file, let's look at the subroutine definitions.

The get_state( )subroutine reads the values of a number of CGI parameters and populates them into the $state hash, which it then returns:

sub get_state {
    return undef unless param( );
    my $state = {  };
    foreach (qw(word gameno left won total guessed)) {
        $state->{$_} = param($_);
    }
    return $state;
}

The initializesubroutine is called to start a new game. It picks a new random word and updates the existing $state hash or creates a new one:

sub initialize {
    my $state = shift || { };

    # pick a word, any word
    my $list = IO::File->new(WORDS) 
        || die "Couldn't open ${\WORDS}: $!\n";
    my $word;
    rand($.) < 1 && ($word = $_) while <$list>;
    chomp $word;

    # setup state
    $state->{word}    = $word;
    $state->{left}    = TRIES;
    $state->{guessed} = '';
    $state->{gameno} += 1;
    $state->{won}    += 0;
    $state->{total}  += 0;
    return $state;
}

The process_guess( )subroutine contains the core of the game logic. It processes the guess passed as the first argument and updates the current state passed as the second. It returns two values: a message for displaying to the user and a status flag indicating the current state of play.

sub process_guess {
    my($guess, $state) = @_;

    # lose immediately if user has no more guesses left
    return ('', 'lost') unless $state->{left} > 0;

    my %guessed = map { $_ => 1 } $state->{guessed} =~ /(.)/g;
    my %letters = map { $_ => 1 } $state->{word} =~ /(.)/g;

    # return immediately if user has already guessed the word
    return ('', 'won') unless grep(!$guessed{$_}, keys %letters);

    # do nothing more if no guess
    return ('', 'continue') unless $guess;

    # This section processes individual letter guesses
    $guess = lc $guess;
    return ("Not a valid letter or word!", 'error') 
        unless $guess =~ /^[a-z]+$/;
    return ("You already guessed that letter!", 'error')
        if $guessed{$guess};

    # This section is called when the user guesses the whole word
    if (length($guess) > 1 and $guess ne $state->{word}) {
        $state->{total} += $state->{left};
        return ( qq{Loser!  The word was "$state->{word}."}, 'lost')
    }

    # update the list of guesses
    foreach ($guess =~ /(.)/g) { $guessed{$_}++; }
    $state->{ guessed } = join '', sort keys %guessed;

    # correct guess -- word completely filled in
    unless (grep(!$guessed{$_}, keys %letters)) {
        $state->{won}++;
        return (qq{Bingola!  The word was "$state->{word}."}, 'won');
    }

    # incorrect guess
    if (!$letters{$guess}) {
        $state->{total}++;
        $state->{left}--;
        # user out of turns
        return (qq{The jig is up!  The word was "$state->{word}".}, 'lost')
            if $state->{left} <= 0;
        # user still has some turns
        return ('Wrong guess!', 'continue');
    }

    # correct guess but word still incomplete
    return (qq{Good guess!}, 'continue');

}

In addition to these subroutines that are called from Perl, we also define wordmap( ) and bind it by reference to the corresponding wordmap template argument. This allows it to be called from within the template.

sub wordmap {
    my($word, $guessed) = @_;
        my %guessed = map { $_ => 1 } $guessed =~ /(.)/g;
        join '', map { $guessed{$_} ? "$_ " : '_ ' } $word =~ /(.)/g;
}

The subroutine expects to be passed the current word and a string containing the letters previously guessed. It returns a string representing the word with only the guessed letters shown and the others blanked out.

At the end of the script, we have the template that is processed to generate the HTML output. Notice that it follows the _ _DATA_ _ marker, which Perl will automatically bind to the *DATA file handle that we passed as the first argument to the process( ) method.[62]

[62]The drawback of using the __DATA__ marker is that you cannot run this script under Apache::Registry, as we explained in Chapter 6. However, the script can be easily converted into a mod_perl handler, which has no problems with the _ _DATA_ _ marker.

In the opening segment, we first define the content type and general HTML headers. This is followed by a directive that defines a particular format for displaying floating-point numbers, done by means of a standard format plug-in loaded via the USE directive. We then go on to calculate the number of tries remaining and the current game averages, storing them in a hash array named average:

__DATA__
Content-type: text/html

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<html>
<head>
  <title>[% title %]</title>
</head>

<body onload="if (document.gf) document.gf.guess.focus( )">
[%
    # define a format for displaying averages
    USE format('%2.3f');

    # how many guesses left to go?
    tries_left = tries - state.left 

    # calculate current averages
    average = {
      current = state.total / state.gameno
      overall = state.gameno > 1 
        ? ( state.total - (tries - state.left)) / (state.gameno - 1)
        : 0
    }
%]

This next section displays the game title and the appropriate image for the number of tries left. It then generates a table to display the current game averages. Note that the format is now used to display the floating-point averages to a fixed precision.

<h1>[% title %]</h1>

<img src="[% icons %]/h[% tries_left %].gif"
     align="left" alt="[[% tries_left %] tries left]" />

<table width="100%">
<tr>
  <td><b>Word #: [% state.gameno %]</b></td>
  <td><b>Guessed: [% state.guessed %]</b></td>
</tr>
<tr>
  <td><b>Won: [% state.won %]</b></td>
  <td><b>Current average: [% format(average.current) %]</b></td>
  <td><b>Overall average: [% format(average.overall) %]</b></td>
</tr>
</table>

This is where we display the current word with unguessed letters blanked out. We're using the wordmap variable, which results in a call back to our wordmapsubroutine. We pass the current word and string of guessed letters as arguments:

<h2>Word: [% wordmap(state.word, state.guessed) %]</h2>

Is there a message to display? If so, this code makes it stand out as a red level-2 heading; otherwise, it does nothing.

[% IF message -%]
<h2><font color="red">[% message %]</font></h2>
[% END %]

Now we can generate the input form:

<form method="post" action="[% url %]" name="gf"
      enctype="application/x-www-form-urlencoded">

[% FOREACH var = [ 'word' 'gameno' 'left'
                   'won' 'total' 'guessed' ]
-%]
<input type="hidden" name="[% var %]" value="[% state.$var %]" />
[% END %]

We're taking the simple approach and using hidden form variables to maintain the state of the game between requests. The FOREACH loop shown above generates these fields for each of state.word, state.gameno, state.left, state.won, state.total, and state.guessed. Rather than spelling out each one, it uses an interpolated variable, state.$var. The leading $ means that the value of the var variable is used to specify the intended item in state. In Perl, this would be just like writing $state->{ $var }.

[% IF status =  = 'won' or status =  = 'lost' %]
   Do you want to play again?
   <input type="submit" name="restart" value="Another game" />
[% ELSE %]
   Your guess: <input type="text" name="guess" />
   <input type="submit" name=".submit" value="Guess" />
[% END %]

</form>

If the current game status is "won" or "lost", the game is over and we generate a button allowing the player to start a new game. Otherwise, it's business as usual and we generate an input field for the guess before closing up the form.

Finally, we have the page footer to add some trailing text and tidy up everything nicely:

<br clear="all">
<hr />

<a href="[% url %]">Home</a>

<p>
  <cite style="fontsize: 10pt">graphics courtesy Andy Wardley</cite>
</p>

</body>
</html>

And that's it! We now have a self-contained CGI script that can be installed and run from a cgi-bin directory with little or no configuration required (see Figure D-2).

Figure D-2

Figure D-2. Self-contained CGI hangman