cgi-dev

Repository that serves as my CGI "scratchpad" to try things out.
git clone git://git.samirparikh.com/cgi-dev
Log | Files | Refs | README

commit 0327f3d8693661fc15a259ec2995dc75d6714069
parent 268858842ed87b5773afc294ad9fcc157a042016
Author: Samir Parikh <noreply@samirparikh.com>
Date:   Fri, 25 Feb 2022 15:21:05 +0000

initial commit to hangman game for message authentication checks

Diffstat:
Ahangman3.cgi | 209+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 209 insertions(+), 0 deletions(-)

diff --git a/hangman3.cgi b/hangman3.cgi @@ -0,0 +1,209 @@ +#!/usr/bin/perl + +# file: hangman1.cgi +# hangman game using hidden fields to maintain state + +use IO::File(); +use CGI qw( :standard ); +use CGI::Cookie (); +use warnings; +use strict; + +use constant WORDS => '/usr/share/dict/hangman_words'; +use constant TRIES => 6; +use constant COOKIE_NAME => 'Hangman'; + +# retrieve the state +#my $state = get_state(); # $state is a hash reference +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; +# foreach (qw(WORD GAMENO GUESSES_LEFT WON TOTAL GUESSED)) { +# print hidden( +# -name => $_, -value=> $state->{$_}, -override => 1 +# ); +# } +#} + +sub save_state { + my $state = shift; + return CGI::Cookie->new ( + -name => COOKIE_NAME, + -value => $state, + -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; + return \%cookie; +} + +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; +}