cgi-dev

hangman4.cgi (7178B) - raw

---

 #!/usr/bin/perl
 
 # file: hangman4.cgi
 # hangman game using simple cookie and message authentication
 # state and encyprtion to maintain state
 
 use IO::File();
 use CGI qw( :standard );
 use CGI::Cookie ();
 use MD5 ();
 use Crypt::CBC ();
 use warnings;
 use strict;
 
 use constant WORDS => '/usr/share/dict/hangman_words';
 use constant TRIES => 6;
 use constant COOKIE_NAME => 'Hangman4';
 use constant SECRET => 'kiddo';
 
 # retrieve the state
 my $CIPHER ||= Crypt::CBC->new( SECRET, 'IDEA' );
 my $state = get_state() unless param('clear');
 
 # 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);
 
 # generate the HTML page
 print   header(-charset    => 'utf-8',
                -cookie => save_state($state)
               ),
         start_html( -Title   => 'Hangman 1',
                     -bgcolor => 'white',
                     -onLoad  => 'if (document.gf) document.gf.guess.focus()'),
         h1( 'Hangman 1 Interactive Game' );
 
 # draw the statistics
 status( $message, $state );
 
 # prompt the user to restart or to enter the next guess
 if ( $status =~ /^(won|lost)$/ ) {
     show_restart_form($state);
 } else {
     show_guess_form($state);
 }
 print   hr,
         a( {-href => '/'}, "Home"),
         p( cite( {-style => "fontsize: 10pt"},
                  'graphics courtesy of Andy Wardley')),
         end_html();
 
 # 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->{GUESSED}           = ''; # empty hash reference
     $state->{GAMENO}            += 1;
     $state->{WON}               += 0;
     $state->{TOTAL}             += 0;
     return $state;
 }
 
 sub save_state {
     my $state = shift;
     MAC($state, 'generate');
     # encrypt the cookie
     my $encrypted = $CIPHER->encrypt_hex(join ':', %{$state});
     return CGI::Cookie->new (
         -name   => COOKIE_NAME,
         -value  => $encrypted,
         -expires => '+1M'
     );
 }
 
 #sub get_state {
 #    return undef unless param();
 #    my $state = {};
 #    foreach (qw(WORD GAMENO GUESSES_LEFT WON TOTAL GUESSED)) {
 #        $state->{$_} = param($_);
 #    }
 #    return $state;
 #}
 
 sub get_state {
     my %cookie = cookie( COOKIE_NAME );
     return undef unless %cookie;
     # decrypt the cookie
     my %state = split ':', $CIPHER->decrypt_hex( %cookie );
     authentication_error() unless MAC(\%state, 'check');
     return \%state;
 }
 
 sub show_guess_form {
    my $state = shift;
    print start_form(-name => 'gf'),
          "Your guess: ",
          textfield(-name => 'guess', -value => '', -override => 1),
          submit(-value => 'Guess');
    #save_state($state);
    print end_form;
 }
 
 sub show_restart_form {
    my $state = shift;
    print start_form,
          "Do you want to play again?",
          submit(-name => 'restart',
                 -value => 'Another game'),
          checkbox(-name => 'clear', -label => 'Clear history');
    delete $state->{WORD};
    #save_state($state);
    print end_form;
 }
 
 sub process_guess { # returns message and status
     my ( $guess, $state ) = @_;
 
     # lose immediately if user has no more guesses left
     #return ('', 'lost') unless $state->{GUESSES_LEFT} > 0;
     #return ('', 'lost') unless $state->{GUESSES_LEFT};
 
     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};
         return (qq(You lose. The word was "$state->{WORD}".), 'lost');
     }
 
     # update the list of guesses
     $guessed{$_}++ foreach ($guess =~ /(.)/g);
     $state->{GUESSED} = join '', sort keys %guessed;
 
     # correct guess -- word completely filled in
     unless (grep(!$guessed{$_}, keys %letters)) {
         $state->{WON}++;
         return (qq(You won! The word was "$state->{WORD}".), 'won');
     }
 
     # incorrect guess
     if (!$letters{$guess}) {
         $state->{TOTAL}++;
         $state->{GUESSES_LEFT}--;
         # user out of turns
         return (qq(Sorry, you're out of turns. 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 ("Good guess.", 'continue');
 }
 
 sub status {
     my ( $message, $state ) = @_;
 
     # print the word with underscores replacing unguessed letters
     print table( { -width => '50%' },
         TR(
             td(b('Word #:'), $state->{GAMENO}),
             td(b('Guessed:'), $state->{GUESSED})
           ),
         TR(
             td(b('Won:'), $state->{WON}),
             td(b('Current average:'),
                 sprintf("%2.3f", $state->{TOTAL}/$state->{GAMENO})),
             td(b('Overall average:'),
                 $state->{GAMENO} > 1 ?
                     sprintf("%2.3f",
                         ($state->{TOTAL}-(TRIES-$state->{GUESSES_LEFT}))/
                             ($state->{GAMENO}-1))
                     : '0.000')
            )
     );
 
     my %guessed = map { $_ => 1 } $state->{GUESSED} =~ /(.)/g;
     print h2("Word:",
         map {$guessed{$_} ? $_ : '_'} $state->{WORD} =~ /(.)/g);
     print h2(font({-color => 'red'}, $message)) if $message;
 }
 
 # 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;
 }
 
 sub MAC {
     my ($state, $action) = @_;
     return unless ref( $state );
     my @fields = @{$state}{qw(WORD GUESSES_LEFT GUESSED GAMENO WON TOTAL)};
     my $newmac = MD5->hexhash(
         SECRET . MD5->hexhash( join '', SECRET, @fields )
     );
     return $state->{MAC} = $newmac if $action eq 'generate';
     return $newmac eq $state->{MAC} if $action eq 'check';
     return undef;
 }
 
 sub authentication_error {
     my $cookie = CGI::Cookie->new(-name => COOKIE_NAME, -value=>'',-expires => '-1d');
     print header(-cookie => $cookie),
           start_html(-title => 'Authentication Error'),
           h1(font({-color => 'red'}, 'Authentication Error')),
           p('This application was unable to confirm the integrity of the',
           'cookie that holds your current score.',
           'Please reload the page to start a fresh session.'),
           p('If the problem persists, contact the webmaster.');
     exit 0;
 }