cgi-dev

guess_number3.cgi (6670B) - raw

---

 #!/usr/bin/perl
 
 use warnings;
 use strict;
 use CGI;
 use CGI::Cookie ();
 use MD5 ();
 
 use constant TRIES       => 6;
 use constant COOKIE_NAME => 'guess_number_3';
 use constant SECRET      => 'mySuperSecretSecret';
 my $game                 =  CGI->new;
 
 # state maintenance subroutines
 sub get_state {
     my %state = $game->cookie( COOKIE_NAME );
     return undef unless %state;
     authentication_error() unless cookie_check( \%state, 'check');
     return \%state;
 }
 
 sub initialize {
     my $state = shift;
     $state = {} unless $state;
     $state->{NUMBER}            = int( rand( 99 ) ) + 1;
     $state->{GAMENO}            += 1;
     $state->{GUESSES_LEFT}      = TRIES;
     $state->{WON}               += 0;
     $state->{GUESSED}           = '';
     return $state;
 }
 
 sub save_state {
     my $state = shift;
     cookie_check( $state, 'generate' );
     return CGI::Cookie->new (
         -name           => COOKIE_NAME,
         -value          => $state,
         -expires        => '+1M',
     );
 }
 
 # game play logic
 sub process_guess {
     my ( $guess, $state ) = @_;
 
     # process list of previous guesses
     my %guessed = map { $_ => 1 } split /,/, $state->{GUESSED};
 
     # do nothing if user did not enter a guess
     return ('', 'continue') unless $guess;
 
     # ensure guess is a valid number between 1 and 100
     return ("Not a valid guess.", 'error')
         unless $guess =~ m/^[1-9][0-9]?$|^100$/;
 
     # check if user already entered this guess previously
     return ("You already guessed that number.", 'error')
         if $guessed{ $guess };
 
     # we have a valid guess.  update list of guesses
     $guessed{ $guess } = 1;
     $state->{GUESSED} = join ',', sort keys %guessed;
 
     $state->{GUESSES_LEFT}--;
 
     # the order of the checks is important here.  At this point, it's
     # possible that the player has used their last guess.  Therefore,
     # we first check whether the guess is correct
 
     # guess is correct!
     if ( $guess == $state->{NUMBER} ) {
         $state->{WON}++;
         return ("Congratulations! You guessed that the correct number
             was $state->{NUMBER}!", 'won');
     }
 
     # if the guess is not correct AND we are out of guesses...
     return ("Sorry, you ran out of turns. The number was $state->{NUMBER}.",
         'lost') unless ($state->{GUESSES_LEFT} && $guess != $state->{NUMBER});
 
     # otherwise...
     # guess too low
     return ("Your guess is too low.", 'continue')
         if ( $guess < $state->{NUMBER} );
 
     # ...or
     # guess is too high
     return ("Your guess is too high.", 'continue')
         if ( $guess > $state->{NUMBER} );
 
 }
 
 # html generation subroutines
 sub print_header {
     my $state = shift;
     print $game->header(
         -type       => "text/html",
         -charset    => 'utf-8',
         -cookie     => save_state( $state ),
     );
     print $game->start_html(
         -title      => "Guess a Secret Number!",
         -onLoad     => 'if (document.gf) document.gf.guess.focus()'
     );
     print $game->h1( 'Guess a Secret Number Interactive Game' );
 }
 
 sub print_status {
     my ( $message, $state ) = @_;
 
     # draw table
     print
         $game->table( { -border=>"0", -width=>"50%" },
             $game->Tr(
                 $game->td( $game->b("Game #: "), $state->{GAMENO} ),
                 $game->td( $game->b("Wins: "),   $state->{WON} )
             ),
             $game->Tr(
                 $game->td( $game->b("Guesses Left: "),    $state->{GUESSES_LEFT} ),
                 $game->td( $game->b("Numbers Guessed: "), $state->{GUESSED} )
             )
         );
     print $game->h2( $game->font( {-color => 'red'}, $message ))
         if $message;
 }
 
 sub show_restart_form {
     my $state = shift;
     print $game->start_form();
     print $game->p(
         #-style => 'padding-right: 25px',
         'Do you want to play again?',
     );
     print $game->submit (
         -name  => 'restart',
         -value => 'Play again',
         #-style => 'padding-left: 25px; padding-right: 25px',
     );
     print $game->checkbox (
         -name  => 'clear',
         -label => 'Clear history',
     );
     print $game->end_form();
 }
 
 sub show_guess_form {
     my $state = shift;
     print $game->start_form( -name => 'gf' );
     print "Your guess: ";
     print $game->textfield (
         -inputmode     => 'numeric', # force number pad on mobile
         -pattern  => '[0-9]*',       # force number pad on mobile
         -name     => 'guess',
         -value    => '',
         -override => 1
     );
     print $game->submit (
         -name     => '_guess',
         -value    => 'Guess'
     );
     print $game->end_form();
 }
 
 sub print_footer {
     print $game->hr;
     print $game->p(
         'inspired by Hangman game from ',
         $game->a(
             { -href => "https://www.oreilly.com/library/view/writing-apache-modules/156592567X/"},
             $game->i( 'Writing Apache Modules with Perl and C')
         ),
         ' by Lincoln Stein and Doug MacEachern.'
     );
     print $game->end_html();
 }
 
 # message authentication checks
 sub cookie_check {
     my ($state, $action) = @_;
     return unless ref( $state );
     my @fields = @{$state}{qw(NUMBER GUESSES_LEFT GUESSED GAMENO WON)};
     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 $game->header(-cookie => $cookie),
           $game->start_html(-title => 'Authentication Error'),
           $game->h1($game->font({-color => 'red'}, 'Authentication Error')),
           $game->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.'),
           $game->p('If the problem persists, contact the webmaster.');
     exit 0;
 }
 
 # begin main program
 # retrieve current state
 my $state = get_state() unless $game->param( 'clear' );
 
 # initialize state if we are starting from the beginning (!$state)
 # or if we are playing another game ($game->param( 'restart' )).
 if ( !$state || $game->param( 'restart' ) ) {
     $state = initialize( $state );
 }
 
 # process current guess, if any
 my ( $message, $status ) =
     process_guess( $game->param( 'guess' ) || '', $state );
 
 # generate the HTML page
 print_header( $state );
 print_status( $message, $state );
 
 # prompt user
 if ( $status =~ /^(won|lost)$/ ) {
     show_restart_form( $state );
 } else {
     show_guess_form( $state );
 }
 
 print_footer();