D.8.1. Hangman CGI Script

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.

Figure D-2. Self-contained CGI hangman

D.8.2. Hangman with Modular Templates

We're also going to use a standard html/page template, provided as part of the Template Toolkit, to generate the required container elements to make a valid HTML page. The default location for these templates is /usr/local/tt2/templates. You will also need to define the directory in which you're going to put the hangman templates. So, to the top of the previous script, we can add the following constant definitions (tailor them to your local values, of course):

use constant TEMPLATES => '/home/stas/templates/hangman2';
use constant SHARED    => '/usr/local/tt2/templates';

Then, when we create the Template object, we specify these directories as a list reference for the INCLUDE_PATH option:

# create a Template object
my $tt = Template->new({
    INCLUDE_PATH => [ TEMPLATES, SHARED ],
});

The rest of the script remains the same, with exception of the template specified in the _ _DATA_ _section. This can now be written as:

_ _DATA_ _
Content-type: text/html

[% WRAPPER html/page
     html.head.title  = title
     html.body.onload = 'if (document.gf) document.gf.guess.focus( )'
%]

[% PROCESS header %]

[% IF status =  = 'won' or status =  = 'lost';
      PROCESS restart;
   ELSE;
      PROCESS guess;
   END
%]

[% PROCESS footer %]

[% END %]

We've moved the header, the footer, and the two different variants of the form out into separate templates. The entire page is enclosed within a WRAPPER block, which generates the required <html>, <head>, and <body> tags to wrap around the page using the standard html/page template.

The external header and footer templates are shown in Examples D-6 and D-7. According to the value of TEMPLATESset above, these should be located in /home/stas/templates/hangman.

D.8.3. Hangman Plug-in

#------------------------------------------------------------------
# Template::Plugin::Games::Hangman
#
# Implementation of the classic hangman game written as a 
# plug-in module for the Template Toolkit.
#
# Written by Andy Wardley.
#------------------------------------------------------------------

package Template::Plugin::Games::Hangman;

use strict;
use Template::Plugin;
use Template::Exception;
use IO::File ( );
use CGI;

use base qw( Template::Plugin );

our $URL    = '/cgi-bin/hangman';
our $ICONS  = '/icons/hangman';
our $WORDS  = '/usr/games/hangman-words';
our $TRIES  = 6;
our @STATE  = qw( word gameno left won total guessed );

The start of the module is very similar to the CGI script. In this case we're defining everything to be in the Template::Plugin::Games::Hangman namespace and specifying that it is a subclass of the Template::Plugin module.

sub new {
    my($class, $context, $config) = @_;

    # create plugin object
    my $self = bless {
        cgi      => CGI->new( ),
        url      => $config->{ url    } || $URL,
        icons    => $config->{ icons  } || $ICONS,
        words    => $config->{ words  } || $WORDS,
        tries    => $config->{ tries  } || $TRIES,
        _context => $context,
    }, $class;

    # restore current game or start new game
    $self->restore( ) || $self->init( );

    return $self;
}

When the plug-in is loaded via a USE directive, the new( ) constructor method is called. The first (zeroth) argument is the calling class name, Template::Plugin::Games::Hangman->new($context, $config), passed as a reference to a context object through which you can access the functionality of the Template Toolkit. The second argument is a reference to a hash array of any configuration items specified with the USE directive.

This method defines an object, $self, using values defined in the $config hash or the defaults specified in the approprate package variables. It then calls the restore( ) method and, if restore( ) doesn't return a true value, the init( ) method. Here are the definitions of those methods:

sub restore {
    my $self = shift;
    my $cgi  = $self->{ cgi };
    return undef if !$cgi->param( );
    $self->{ $_ } = $cgi->param($_) foreach @STATE;
    return undef if $cgi->param('restart');
    return $self;
}

sub init {
    my $self = shift;

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

    $self->{ word    }  = $word;
    $self->{ left    }  = $self->{ tries };
    $self->{ guessed }  = '';
    $self->{ gameno  } += 1;
    $self->{ won     } += 0;
    $self->{ total   } += 0;
    return $self;
}

They are just like their counterparts in the earlier CGI script, with a few minor exceptions. A CGI object is defined in $self->{ cgi } rather than using imported subroutines, and operations are performed on $self rather than on a $state hash array passed as an argument.

The guess( ) method is also very similar to the process_guess( )subroutine in the CGI script:

sub guess {
    my $self  = shift;
    my $cgi   = $self->{ cgi };
    my $guess = $cgi->param('guess') || return;

    # lose immediately if user out of guesses
    return $self->state('lost') 
        unless $self->{ left } > 0;

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

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

    # do nothing more if no guess
    return $self->state('continue') unless $guess;

    # process individual letter guesses
    $guess = lc $guess;
    return $self->state(continue => 'Not a valid letter or word!') 
        unless $guess =~ /^[a-z]+$/;
    return $self->state(continue => 'You already guessed that letter!')
        if $guessed{$guess};

    # handle the user guessing the whole word
    if (length($guess) > 1 and $guess ne $self->{word}) {
        $self->{ total } += $self->{ left };
        return $self->state(lost => "You lose.  The word was $self->{word}.");
    }

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

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

    # incorrect guess
    if (!$letters{$guess}) {
        $self->{total}++;
        $self->{left}--;
        return $self->state(lost => 
            qq{No dice, dude! The word was "$self->{word}".})
                if $self->{left} <= 0;
        return $self->state(continue => 'Wrong guess!');
    }

    # correct guess but word still incomplete
    return $self->state(continue => 'Good guess!');
}

As a matter of convenience, we also provide the state( ) method, to retrieve the current state (when called without arguments) or set both state and message (when called with one or more arguments):

sub state {
    my $self = shift;
    if (@_) {
        $self->{ state   } = shift;
        $self->{ message } = join('', @_);
    }
    else {
        return $self->{ state };
    }
}

We also define averages( ) and wordmap( ) as object methods:

sub averages {
    my $self = shift;
    return {
        current => $self->{ total } / $self->{ gameno },
        overall => $self->{ gameno } > 1 
             ? ($self->{ total } + $self->{ left } - $self->{ tries }) 
             / ($self->{ gameno } - 1)
             : 0
    };
}

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

We can also encode the high-level game logic in a method:

sub play {
    my $self = shift;

    # process any current guess
    $self->guess( );

    # determine which form to use based on state
    my $form = (exists $self->{ state } &&
                $self->{ state } =~ /^won|lost$/)
        ? 'restart' : 'guess';

    # process the three templates: header, form and footer
    $self->{ _context }->include([ 'header', $form, 'footer' ]);
}

The play( ) method calls guess( ) to process a guess and then calls on the context object that we previously saved in _context to process three templates: the header template, the form relevant to the current game state, and the footer template.

Other than creating a Template object and defining variables, we don't need to do any special processing relevant to the hangman application. That is now handled entirely by the plug-in.

The template defined in the _ _DATA_ _section can be made to look very similar to the earlier example. In this case, we're loading the plug-in (Games.Hangman, corresponding to Template::Plugin::Games::Hangman) and aliasing the object returned from new( ) to the hangman variable. We manually call the guess( ) method and PROCESS external templates according to the game state:

_ _DATA_ _
Content-type: text/html

[%  WRAPPER html/page
        html.head.title  = title
        html.body.onload = 'if (document.gf) document.gf.guess.focus( )';

        TRY;
            # load the hangman plug-in
            USE hangman = Games.Hangman(
                words = words
                icons = icons
                url   = url
            );

            # process a guess
            CALL hangman.guess;

            # print header showing game averages
            PROCESS header;

            # process the right form according to game state
            IF hangman.state =  = 'won'
            OR hangman.state =  = 'lost';
                PROCESS restart;
            ELSE;
                PROCESS guess;
            END;

            # now print the footer
            PROCESS footer;
        CATCH;
            # and if any of that goes wrong...
            CLEAR;
            PROCESS error;
        END;
    END
%]

One other enhancement we've made is to enclose the body in a TRY block. If the plug-in init( ) method fails to open the words file, it reports the error via die( ). The TRY directive allows this error to be caught and handled in the corresponding CATCH block. This clears any output generated in the TRY block before the error occured and processes an error template instead to report the error in a nice manner.

The template in this example controls the overall flow of the game logic. If you prefer, you can simply call the play( ) method and have the plug-in take control. It handles all the flow control for you, processing the guess and then making calls back into the Template Toolkit to process the header, relevant form, and footer templates.

_ _DATA_ _
Content-type: text/html

[%  #Template Toolkit Hangman #4
        WRAPPER html/page
        html.head.title  = title
        html.body.onload = 'if (document.gf) document.gf.guess.focus( )';

        TRY;
            USE hangman = Games.Hangman(
                words = words
                icons = icons
                url   = url
            );
            hangman.play;

        CATCH;
            CLEAR;
            PROCESS error;
        END;
    END
%]

The complete set of templates that go with this final example are presented in Examples D-9 through D-15.

D.8.4. Self-Contained Hangman Template

Here's an example of a self-contained template using the hangman plug-in. All we need to do is to hardcode some variable values at the start of the template:

[%  title = 'Template Toolkit Hangman #5'
    url   = '/tt2/hangman.html'
    words = '/usr/games/hangman-words'
    icons = '/icons/hangman';

    WRAPPER html/page
        html.head.title  = title
        html.body.onload = 'if (document.gf) document.gf.guess.focus( )';

        TRY;
            USE hangman = Games.Hangman(
                words = words
                icons = icons
                url   = url
            );
            hangman.play;
        CATCH;
            CLEAR;
            PROCESS error;
        END;
    END
%]

If you're using Apache::Template to run the application, you can define these variables in the Apache httpd.conf file:

PerlModule          Apache::Template

TT2IncludePath      /usr/local/tt2/hangman/hangman3/templates
TT2IncludePath      /usr/local/tt2/templates
TT2Variable         title  "Template Toolkit Hangman #5"
TT2Variable         words  /usr/games/hangman-words
TT2Variable         icons  /icons/hangman
TT2Params           uri

<Location /tt2/hangman.html>
    SetHandler      perl-script
    PerlHandler     Apache::Template
</Location>

Our three variables, title, words, and icons, are defined using the TT2Variable directive. In addition, we use TT2Params to instruct Apache::Template to make the request URI available as the uri template variable. We previously used url to denote the URL of the hangman application, so we need to make one small change to the template. Using this dynamic uri variable should mean that the value will remain correct even if the application is moved to a new URL. The template should now look like this:

[% 
    # ...etc...

    USE hangman = Games.Hangman(
        words   = words
        icons   = icons
        url     = uri     # now use 'uri' not 'url'
    );

    # ...etc...
%]

Figure D-3. White to play and mate in three moves