Writing Apache Modules with Perl and C By:   Lincoln Stein and Doug MacEachern Published:   O'Reilly & Associates, Inc.  - March 1999 Copyright © 1999 by O'Reilly & Associates, Inc.

Chapter 5 - Maintaining State / Storing State Information in SQL Databases
Using DBI to Its Full Advantage

Once you keep session information stored in a database, there are all sorts of interesting things you can do with it. For example, you can easily compute statistics, such as the average number of games that users have played or how many guesses they have to make on average to arrive at the correct answer.

In this section we take advantage of this ability to create a "top winners" list. Whenever the user finishes a game, or any time he presses the "Show High Scores" button, he is presented with a list of the 15 top-scoring players. If the user is one of the winners, his entry is boldfaced. At the end of each game, the top winners list is displayed again, and the user is given a chance to add his name to the database. The new screen is shown in Figure 5-4.

Figure 5-4. When the user wins this version of the hangman game, he's allowed to enter his name. The top 15 winners are displayed in a hall of fame list.

For variety, this version of hangman stores its session ID in a client-side cookie rather than in the URI.

Because this is the final and most feature-rich version of hangman, we give the code in its entirety in Example 5-8. A variety of things have changed. Let's start with the table definition:

CREATE TABLE hangman (
      session_id      char(8)  primary key,
      username        char(40) default 'anonymous',
      WORD            char(30),
      GUESSED         char(26),
      GAMENO          int,
      WON             int,
      GUESSES_LEFT    int,
      TOTAL           int,
      modified        timestamp,
      KEY(modified)
)

In addition to the state variables that we've used before, we've added a new column named username with a default value of anonymous. When a new user starts playing the game, he is initially anonymous. Whenever he wins a game, he gets the right to enter his name or handle into the database. Subsequently, his name is displayed on the hangman page in nice bold red letters, and it also appears on the top winners list, provided the user can score high enough to get there. Even though the table definition has changed, the get_state() and set_state() subroutines used in the previous version of the game are sufficiently generic that they don't need alteration.

The other change is that the session ID is now stored in a cookie, rather than in a URI. The code required to store the session ID in a cookie is similar to what we used earlier for the shared memory example (Example 5-5):

sub get_session_id {
   my(@result);
   expire_old_sessions();
   my $id = cookie('sessionID');
   return @result if defined($id) and
      $id =~ m/^([a-h0-9]{$ID_LENGTH})$/o and
          @result = check_id($id);
   # If we get here, there's not already a valid cookie
   my $session_id = generate_id();
   die "Couldn't make a new session id" unless $session_id;
   return $session_id;
}

get_session_id() attempts to retrieve a cookie named sessionID. If it finds such a cookie, it first checks that the session ID looks right and then passes it to check_id() to confirm that the session is in the database. If there's no session cookie, it calls generate_id() to create a new ID and return it. Later when we generate the HTTP header we will incorporate this session ID into a cookie that is sent to the client.

The biggest change relative to the previous version of the script is the addition of a new subroutine called show_scores(), which displays an HTML table of the top 15 winners, the number of games they've won and lost, the average number of letters guessed per word, and an aggregate score. This subroutine is called at the end of each game by show_restart_form(), and is also called whenever the user presses the new "Show High Scores" button (CGI parameter show_scores).

The top of the show_scores() routine looks like this:

sub show_scores {
   my($current_session, $count) = @_;
   my $tries = TRIES;
   my $sth = $DBH->prepare(<<END) || die "prepare: ", $DBH->errstr;
SELECT session_id,username,
      GAMENO,WON,(TOTAL+GUESSES_LEFT-$tries)/(GAMENO-1) as AVG,
      round(100*WON/(GAMENO*(TOTAL+GUESSES_LEFT-$tries)/(GAMENO-1)))
      as SCORE
FROM $DB_TABLE
WHERE GAMENO > 1 and TOTAL+GUESSES_LEFT > $tries and WON >
ORDER BY SCORE DESC
LIMIT $count
END

The core of show_scores() is a big SQL SELECT statement that retrieves the top- scoring players based on a formula that divides the percentage of games won by the average number of guesses per game. The SQL statement sorts the returned list in descending order by score, then skims off the top records and returns them. The remainder of the routine calls execute() followed by a fetchrow_array() loop. Each retrieved record is turned into a row of an HTML table and printed out. The code is straightforward; see the listing for the details.

Another significant change is in the show_guess_form() routine:

sub show_guess_form {
   my $state = shift;
   print start_form(-name => 'gf'),
         "Your guess: ",
         textfield(-name => 'guess', -value => '', -override => 1),       
         submit(-value => 'Guess'),
         br({-clear => 'ALL'}),
         submit(-name => 'show_scores', -value => 'Show High Scores'),
   submit(-Style => 'color: red', -name => 'abort', -value => 'Give Up');
   print end_form;
}

This version of show_guess_form() adds a new button labeled "Give Up," which allows the user to give up and move on to the next word. process_guess() is modified to recognize this condition and treat it as an incorrect attempt to guess the whole word.

Other changes to the hangman script allow the user to enter and edit his name. show_restart_form() has been modified to include an HTML text field that prompts the user to type in his name. The routine now looks like this:

sub show_restart_form {
   my($state, $status, $session_id) = @_;
   print start_form;
   print p("Enter your name for posterity: ",
          textfield(-name => 'change_name', -value => $state->{'username'}))
      if $status eq 'won';
   print
      p("Do you want to play again?",
        submit(-name => 'restart', -value => 'Another game'),
        checkbox(-name => 'clear', -label => 'Clear my score'));
   print end_form;
   show_scores($session_id, TOP_COUNT);
}

When the restart form is submitted, the script checks for the change_name parameter and calls a new subroutine named set_username() if present:

set_username($session_id, param('change_name')) if param('change_name');

set_username(), in turn, issues the appropriate SQL UPDATE command to insert the user's name into the database:

sub set_username {
   my($session, $newname) = @_;
   $newname = $DBH->quote($newname);
   $DBH->do("UPDATE $DB_TABLE SET username=$newname
            WHERE session_id='$session'")
      || die "update: ", $DBH->errstr;
}

This subroutine uses a trick that we haven't seen before. Because the username is typed in by the user, there's no guarantee that it doesn't contain funny characters, such as quotation marks, which will throw off the SQL parser. To avoid this, we pass the username through the DBI quote() function. This escapes funny characters and puts quotes around the string, making it safe to use in SQL.

The final frill on this script is an odd little subroutine defined at the bottom of the code named Apache::DBI:db::ping():

sub Apache::DBI::db::ping {
   my $dbh = shift;
   return $dbh->do('select 1');
}

MySQL, like some other networked databases, will time out if a client has been idle for some period of time. If this happens, the hangman script will fail with a fatal database error the next time it tries to make a query. To avoid this eventuality, the Apache::DBI module attempts to reconnect to the database if it notices that the database has gone silent. However, Apache::DBI does this checking by calling the database driver's ping() method, and the MySQL DBI driver doesn't implement ping() (at least, not at the time that this was written). To avoid the embarrassment of having our hangman game get hung, we define our own version of ping(). It simply calls a SQL SELECT statement that's guaranteed to be true. If the database is still up, the call succeeds. If the database has timed out, the subroutine returns false and Apache::DBI reestablishes the connection behind the scenes.

Example 5-8. Hangman with All the Trimmings

# file: hangman7.cgi
# hangman game with all the trimmings

use IO::File ();
use CGI qw(:standard);
use DBI ();
use MD5 ();
use strict;
use vars qw($DBH $DB_TABLE $ID_LENGTH);
use constant WORDS => '/usr/games/lib/hangman-words';
use constant ICONS => '/icons/hangman';
use constant TRIES => 6;
use constant TOP_COUNT => 15; # how many top scores to show

# session settings
use constant EXPIRE => 60*60*24*30;  # allow 30 days before expiration
use constant DB     => 'dbi:mysql:www';
use constant DBAUTH => 'nobody:';
use constant SECRET => "something obscure";
use constant COOKIE_NAME => 'hangman7';
use constant MAX_TRIES => 10;
$DB_TABLE              = "hangman7";
$ID_LENGTH             = 8;

# Open the database
$DBH = DBI->connect(DB, split(':', DBAUTH, 2), {PrintError => 0})
   || die "Couldn't open database: ", $DBI::errstr;

# get the current session ID, or make one
my($session_id, $note) = get_session_id();

# retrieve the state
my $state      = get_state($session_id) unless param('clear');

# reinitialize if we need to -- we need to check for "change_name"
# because it's possible for the user to hit return in the change name field!
$state    = initialize($state) if !$state or param('restart')
   or param('change_name');

# process the current guess, if any
set_username($session_id, param('change_name')) if param('change_name');

my($message, $status) = process_guess(param('guess') || '', $state)
   unless param('show_scores');

# start the page
print header(-Cookie  => cookie(-name    => COOKIE_NAME,

                                -value   => $session_id,
                               -expires => '+' . EXPIRE . 'd')
           ),
   start_html(-Title   => 'Hangman 7',
             -bgcolor => 'white',
             -onLoad  => 'if (document.gf) document.gf.guess.focus()'),
   h1('Hangman 7: DBI Sessions in Cookies');

if (param() and !cookie(COOKIE_NAME)) {
   print h2(font({-color => 'red'},
   "You need to activate cookies to play this game"));
   footer();
   exit 0;
}
print h2(font({-color => 'red'}, "Player: $state->{username}")) if
   $state->{username} and $state->{username} ne 'anonymous';

print p(font({-color => 'red'}, $note)) if $note;

# save the modified state
save_state($state, $session_id);

# draw the statistics
show_status($state);

# Prompt the user to restart or for his next guess.
if (param('show_scores')) {
   show_scores($session_id, TOP_COUNT);
   print start_form, submit(-name => 'play', -value => 'Play'), end_form;
}
else {
   # draw the picture
   show_picture($state);
   show_word($state);
   print h2(font({-color => 'red'}, $message)) if $message;
   if ($status =~ /^(won|lost)$/) {
      show_restart_form($state, $status, $session_id);
   }
   else {
      show_guess_form($state);
  }

footer();
$DBH->disconnect;
########### subroutines ##############
# This is called to process the user's guess
sub process_guess {
   my($guess, $state) = @_;

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

    # lose immediately if user aborted
   if (param('abort')) {
      $state->{TOTAL} += $state->{GUESSES_LEFT};
      $state->{GUESSES_LEFT}  =  0;
      return (qq{Chicken! The word was "$state->{WORD}."}, 'lost') ;
   }

    # break the word and guess into individual letters
   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->{GUESSES_LEFT};
      $state->{GUESSES_LEFT}  = 0;
      return (qq{You lose.  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{You got it!  The word was "$state->{WORD}."}, 'won');
   }

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

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

# create the cute hangman picture
sub show_picture {
   my $tries_left = shift->{GUESSES_LEFT};
   my $picture = sprintf("%s/h%d.gif", ICONS, TRIES-$tries_left);
   print img({-src => $picture,
             -align => 'LEFT',
             -alt => "[$tries_left tries left]"});
}

# print the status
sub show_status {
   my $state = shift;
   my $current_average = $state->{TOTAL}/$state->{GAMENO};
   my $overall_average = $state->{GAMENO}>1 ?
      ($state->{TOTAL}-(TRIES-$state->{GUESSES_LEFT}))/($state->{GAMENO}-1) : 0;
   my $score = $overall_average > 0 ?
      (100*$state->{WON}/($state->{GAMENO}*$overall_average)) : 0;

    # print the word with underscores replacing unguessed letters
   print table(TR({-width => '90%'},
                 td(b('Word #:'), $state->{GAMENO}),
                 td(b('Won:'), $state->{WON}),
                 td(b('Guessed:'), $state->{GUESSED}),
                 ),
              TR(
                 td(b('Current average:'), sprintf("%2.3f", $current_average)),
                 td(b('Overall average:'), sprintf("%2.3f", $overall_average)),
                 td(b('Score:'), sprintf("%3.0f", $score))
                 )
              );
}

sub show_word {
   my $state = shift;
   my %guessed = map { $_ => 1 } $state->{GUESSED} =~ /(.)/g;
   print h2("Word:",
           map {$guessed{$_} ? $_ : '_'}
           $state->{WORD} =~ /(.)/g);
}

# print the fill-out form for requesting input
sub show_guess_form {
   my $state = shift;
   print start_form(-name => 'gf'),
         "Your guess: ",
         textfield(-name => 'guess', -value => '', -override => 1),

          submit(-value => 'Guess'),
         br({-clear => 'ALL'}),
         submit(-name => 'show_scores', -value => 'Show High Scores'),
   submit(-Style => 'color: red', -name => 'abort', -value => 'Give Up');
   print end_form;
}

# ask the user if he wants to start over
sub show_restart_form {
   my($state, $status, $session_id) = @_;
   print start_form;
   print p("Enter your name for posterity: ",
          textfield(-name => 'change_name', -value => $state->{'username'}))
      if $status eq 'won';
   print
      p("Do you want to play again?",
        submit(-name => 'restart', -value => 'Another game'),
        checkbox(-name => 'clear', -label => 'Clear my score'));
   print end_form;
   show_scores($session_id, TOP_COUNT);
}

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

################### state maintenance ###############
# This is called to initialize a whole new state object
# or to create a new game.
sub initialize {
   my $state = shift;
   $state = {} unless $state;
   $state->{WORD}     = pick_random_word();
   $state->{GUESSES_LEFT}     = TRIES;
   $state->{TOTAL}    += 0;
   $state->{GUESSED}  = '';
   $state->{GAMENO}   += 1;
   $state->{WON}      += 0;
   $state->{username} = param('change_name') if param('change_name');
   return $state;
}

# Retrieve the session ID from the path info.  If it's not
# already there, add it to the path info with a redirect.
sub get_session_id {
   my(@result);
   expire_old_sessions();
   my $id = cookie(COOKIE_NAME);
   return @result if defined($id) and
      $id =~ m/^([a-h0-9]{$ID_LENGTH})$/o and
          @result = check_id($id);
   # If we get here, there's not already a valid cookie
   my $session_id = generate_id();
   die "Couldn't make a new session id" unless $session_id;
   return $session_id;
}

# Find a new unique ID and insert it into the database
sub generate_id {
   # Create a new session id
   my $tries = 0;
   my $id = hash(SECRET . rand());
   while ($tries++ < MAX_TRIES) {
      last if $DBH->do("INSERT INTO $DB_TABLE (session_id) VALUES ('$id')");
      $id = hash($id);
   }
   return undef if $tries >= MAX_TRIES;  # we failed
   return $id;
}

# check to see that an old ID is valid
sub check_id {
   my $id = shift;
   return ($id, '')
      if $DBH->do("SELECT 1 FROM $DB_TABLE WHERE session_id='$id'") > 0;
   return ($id, 'The record of your game may have expired.  Restarting.')
      if $DBH->do("INSERT INTO $DB_TABLE (session_id) VALUES ('$id')");
   return ();
}

# generate a hash value
sub hash {
   my $value = shift;
   return substr(MD5->hexhash($value), 0, $ID_LENGTH);
}

sub expire_old_sessions {
   $DBH->do(<<END);
DELETE FROM $DB_TABLE
   WHERE (unix_timestamp()-unix_timestamp(modified))>${\EXPIRE}
END
}

# get the state from the database
sub get_state {
   my $id = shift;
   my $sth = $DBH->prepare("SELECT * FROM $DB_TABLE WHERE session_id='$id'
         AND WORD<>NULL")
      || die "Prepare: ", $DBH->errstr;
   $sth->execute || die "Execute: ", $sth->errstr;
   my $state = $sth->fetchrow_hashref;
   $sth->finish;
   return $state;
}

# save the state in the database
sub save_state {
   my($state, $id) = @_;
   my $sth = $DBH->prepare(<<END) || die "prepare: ", $DBH->errstr;
UPDATE $DB_TABLE
  SET WORD=?,GUESSED=?,GAMENO=?,WON=?,TOTAL=?,GUESSES_LEFT=?
  WHERE session_id='$id'
END
   $sth->execute(@{$state}{qw(WORD GUESSED GAMENO WON TOTAL GUESSES_LEFT)})
      || die "execute: ", $DBH->errstr;
   $sth->finish;
}

# Return true if the current session is one of the top ten
# Overall score is the percentage of games won weighted by the average
# number of guesses taken.
sub show_scores {
   my($current_session, $count) = @_;
   my $tries = TRIES;
   my $sth = $DBH->prepare(<<END) || die "prepare: ", $DBH->errstr;
SELECT session_id,username,
      GAMENO,WON,(TOTAL+GUESSES_LEFT-$tries)/(GAMENO-1) as AVG,
      round(100*WON/(GAMENO*(TOTAL+GUESSES_LEFT-$tries)/(GAMENO-1))) as SCORE
FROM $DB_TABLE
WHERE GAMENO > 1 and TOTAL+GUESSES_LEFT > $tries and WON > 0
ORDER BY SCORE DESC
LIMIT $count
END
   ;
   $sth->execute || die "execute: ", $sth->errstr;

    my @rows = th([qw(Name Games Won Average Score)]);
   while (my(@rec) = $sth->fetchrow_array) {
      my $id = shift @rec;
      push @rows, $id eq $current_session ?
                  th({-align => 'LEFT'}, \@rec) : td(\@rec);
   }
   print br({-clear => 'ALL'}),
           table({-border => 'undef', -width => '75%'},
                 caption(b("Top $count Winners")),
              TR(\@rows));
   $sth->finish;
}

# change the username in the database
sub set_username {
   my($session, $newname) = @_;
   $newname = $DBH->quote($newname);
   $DBH->do("UPDATE $DB_TABLE SET username=$newname
   WHERE session_id='$session'")
      || die "update: ", $DBH->errstr;
}

# fix the absence of ping() in the mysql interface.
sub Apache::DBI::db::ping {
   my $dbh = shift;
   return $dbh->do('select 1');
}

# print bottom of page
sub footer {
   print hr,
   a({-href => '/'}, "Home"),
   p(cite({-Style => "fontsize: 10pt"}, 'graphics courtesy Andy Wardley')),
   end_html();
}

Footnotes

⁷ MySQL can be used freely for some purposes but must be licensed (for a reasonable price) for others. Please see the licensing terms for full details.

⁸ The modified field is a MySQL-specific data type, and later we will take advantage of other MySQL features involving the handling of dates. SQL databases vary widely in their handling of dates and times, and we prefer to show you an efficient implementation of the application on a specific database than an inefficient implementation that might work more generically. To port this code to the database of your choice, you will need to change the data type of the modified column to a date/time type that your database understands and modify the expires() subroutine to work with this changed type.

⁹ If there are many session records, expire_old_sessions() will rapidly become a performance drain on the script. In high-volume applications, you will want to move session expiration into a separate stand-alone process that runs at regular intervals under the Unix cron or NT at utilities. For the hangman application, a nightly expiration is more than sufficient.