hangman3.cgi (7194B) - raw
1 #!/usr/bin/perl 2 3 # file: hangman3.cgi 4 # hangman game using simple cookie and message authentication 5 # state to maintain state 6 7 use IO::File(); 8 use CGI qw( :standard ); 9 use CGI::Cookie (); 10 use MD5 (); 11 use warnings; 12 use strict; 13 14 use constant WORDS => '/usr/share/dict/hangman_words'; 15 use constant TRIES => 6; 16 use constant COOKIE_NAME => 'Hangman3'; 17 use constant SECRET => 'kiddo'; 18 19 # retrieve the state 20 #my $state = get_state(); # $state is a hash reference 21 my $state = get_state() unless param('clear'); 22 23 # reinitialize if we need to 24 $state = initialize($state) if !$state or param('restart'); 25 26 # process the current guess, if any 27 my ($message, $status) = process_guess(param('guess') || '', $state); 28 29 # generate the HTML page 30 print header(-charset => 'utf-8', 31 -cookie => save_state($state) 32 ), 33 start_html( -Title => 'Hangman 1', 34 -bgcolor => 'white', 35 -onLoad => 'if (document.gf) document.gf.guess.focus()'), 36 h1( 'Hangman 1 Interactive Game' ); 37 38 # draw the statistics 39 status( $message, $state ); 40 41 # prompt the user to restart or to enter the next guess 42 if ( $status =~ /^(won|lost)$/ ) { 43 show_restart_form($state); 44 } else { 45 show_guess_form($state); 46 } 47 print hr, 48 a( {-href => '/'}, "Home"), 49 p( cite( {-style => "fontsize: 10pt"}, 50 'graphics courtesy of Andy Wardley')), 51 end_html(); 52 53 # This is called to initialize a whole new state object 54 # or to create a new game. 55 sub initialize { 56 my $state = shift; 57 $state = {} unless $state; 58 $state->{WORD} = pick_random_word(); 59 $state->{GUESSES_LEFT} = TRIES; 60 $state->{GUESSED} = ''; # empty hash reference 61 $state->{GAMENO} += 1; 62 $state->{WON} += 0; 63 $state->{TOTAL} += 0; 64 return $state; 65 } 66 67 #sub save_state { 68 # my $state = shift; 69 # foreach (qw(WORD GAMENO GUESSES_LEFT WON TOTAL GUESSED)) { 70 # print hidden( 71 # -name => $_, -value=> $state->{$_}, -override => 1 72 # ); 73 # } 74 #} 75 76 sub save_state { 77 my $state = shift; 78 MAC($state, 'generate'); 79 return CGI::Cookie->new ( 80 -name => COOKIE_NAME, 81 -value => $state, 82 -expires => '+1M' 83 ); 84 } 85 86 #sub get_state { 87 # return undef unless param(); 88 # my $state = {}; 89 # foreach (qw(WORD GAMENO GUESSES_LEFT WON TOTAL GUESSED)) { 90 # $state->{$_} = param($_); 91 # } 92 # return $state; 93 #} 94 95 sub get_state { 96 my %cookie = cookie( COOKIE_NAME ); 97 return undef unless %cookie; 98 authentication_error() unless MAC(\%cookie, 'check'); 99 return \%cookie; 100 } 101 102 sub show_guess_form { 103 my $state = shift; 104 print start_form(-name => 'gf'), 105 "Your guess: ", 106 textfield(-name => 'guess', -value => '', -override => 1), 107 submit(-value => 'Guess'); 108 #save_state($state); 109 print end_form; 110 } 111 112 sub show_restart_form { 113 my $state = shift; 114 print start_form, 115 "Do you want to play again?", 116 submit(-name => 'restart', 117 -value => 'Another game'), 118 checkbox(-name => 'clear', -label => 'Clear history'); 119 delete $state->{WORD}; 120 #save_state($state); 121 print end_form; 122 } 123 124 sub process_guess { # returns message and status 125 my ( $guess, $state ) = @_; 126 127 # lose immediately if user has no more guesses left 128 #return ('', 'lost') unless $state->{GUESSES_LEFT} > 0; 129 #return ('', 'lost') unless $state->{GUESSES_LEFT}; 130 131 my %guessed = map { $_ => 1 } $state->{GUESSED} =~ /(.)/g; 132 my %letters = map { $_ => 1 } $state->{WORD} =~ /(.)/g; 133 134 # return immediately if user has already guessed the word 135 return ('', 'won') unless grep(!$guessed{$_}, keys %letters); 136 137 # do nothing more if no guess 138 return ('', 'continue') unless $guess; 139 140 # this section processes individual letter guesses 141 $guess = lc $guess; 142 return ("Not a valid letter or word", 'error') 143 unless $guess =~ /^[a-z]+$/; 144 return ("You already guessed that letter", 'error') 145 if $guessed{$guess}; 146 147 # this section is called when the user guesses the whole word 148 if (length($guess) > 1 and $guess ne $state->{WORD}) { 149 $state->{TOTAL} += $state->{GUESSES_LEFT}; 150 return (qq(You lose. The word was "$state->{WORD}".), 'lost'); 151 } 152 153 # update the list of guesses 154 $guessed{$_}++ foreach ($guess =~ /(.)/g); 155 $state->{GUESSED} = join '', sort keys %guessed; 156 157 # correct guess -- word completely filled in 158 unless (grep(!$guessed{$_}, keys %letters)) { 159 $state->{WON}++; 160 return (qq(You won! The word was "$state->{WORD}".), 'won'); 161 } 162 163 # incorrect guess 164 if (!$letters{$guess}) { 165 $state->{TOTAL}++; 166 $state->{GUESSES_LEFT}--; 167 # user out of turns 168 return (qq(Sorry, you're out of turns. The word was "$state->{WORD}".), 169 'lost') if $state->{GUESSES_LEFT} <= 0; 170 # user still has some turns 171 return ("Wrong guess", 'continue'); 172 } 173 174 # correct guess but word still incomplete 175 return ("Good guess.", 'continue'); 176 } 177 178 sub status { 179 my ( $message, $state ) = @_; 180 181 # print the word with underscores replacing unguessed letters 182 print table( { -width => '50%' }, 183 TR( 184 td(b('Word #:'), $state->{GAMENO}), 185 td(b('Guessed:'), $state->{GUESSED}) 186 ), 187 TR( 188 td(b('Won:'), $state->{WON}), 189 td(b('Current average:'), 190 sprintf("%2.3f", $state->{TOTAL}/$state->{GAMENO})), 191 td(b('Overall average:'), 192 $state->{GAMENO} > 1 ? 193 sprintf("%2.3f", 194 ($state->{TOTAL}-(TRIES-$state->{GUESSES_LEFT}))/ 195 ($state->{GAMENO}-1)) 196 : '0.000') 197 ) 198 ); 199 200 my %guessed = map { $_ => 1 } $state->{GUESSED} =~ /(.)/g; 201 print h2("Word:", 202 map {$guessed{$_} ? $_ : '_'} $state->{WORD} =~ /(.)/g); 203 print h2(font({-color => 'red'}, $message)) if $message; 204 } 205 206 # pick a word, any word 207 sub pick_random_word { 208 my $list = IO::File->new(WORDS) 209 || die "Couldn't open ${\WORDS}: $!\n"; 210 my $word; 211 rand($.) < 1 && ($word = $_) while <$list>; 212 chomp $word; 213 $word; 214 } 215 216 sub MAC { 217 my ($state, $action) = @_; 218 return unless ref( $state ); 219 my @fields = @{$state}{qw(WORD GUESSES_LEFT GUESSED GAMENO WON TOTAL)}; 220 my $newmac = MD5->hexhash( 221 SECRET . MD5->hexhash( join '', SECRET, @fields ) 222 ); 223 return $state->{MAC} = $newmac if $action eq 'generate'; 224 return $newmac eq $state->{MAC} if $action eq 'check'; 225 return undef; 226 } 227 228 sub authentication_error { 229 my $cookie = CGI::Cookie->new(-name => COOKIE_NAME, -value=>'',-expires => '-1d'); 230 print header(-cookie => $cookie), 231 start_html(-title => 'Authentication Error'), 232 h1(font({-color => 'red'}, 'Authentication Error')), 233 p('This application was unable to confirm the integrity of the', 234 'cookie that holds your current score.', 235 'Please reload the page to start a fresh session.'), 236 p('If the problem persists, contact the webmaster.'); 237 exit 0; 238 }