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

guess_number4.cgi (6928B) - raw


      1 #!/usr/bin/perl
      2 
      3 use warnings;
      4 use strict;
      5 use CGI;
      6 use CGI::Cookie ();
      7 use MD5 ();
      8 use Crypt::CBC ();
      9 
     10 use constant TRIES       => 6;
     11 use constant COOKIE_NAME => 'guess_number_4';
     12 use constant SECRET      => 'mySuperSecretSecret';
     13 my $game                 =  CGI->new;
     14 my $CIPHER               ||= Crypt::CBC->new( SECRET, 'IDEA' );
     15 
     16 # state maintenance subroutines
     17 sub get_state {
     18     my %cookie = $game->cookie( COOKIE_NAME );
     19     return undef unless %cookie;
     20     # decrypt the cookie
     21     my %state = split ':', $CIPHER->decrypt_hex( %cookie );
     22     authentication_error() unless cookie_check( \%state, 'check');
     23     return \%state;
     24 }
     25 
     26 sub initialize {
     27     my $state = shift;
     28     $state = {} unless $state;
     29     $state->{NUMBER}            = int( rand( 99 ) ) + 1;
     30     $state->{GAMENO}            += 1;
     31     $state->{GUESSES_LEFT}      = TRIES;
     32     $state->{WON}               += 0;
     33     $state->{GUESSED}           = '';
     34     return $state;
     35 }
     36 
     37 sub save_state {
     38     my $state = shift;
     39     cookie_check( $state, 'generate' );
     40     # encrypt cookie
     41     my $encrypted = $CIPHER->encrypt_hex(join ':', %{$state});
     42     return CGI::Cookie->new (
     43         -name           => COOKIE_NAME,
     44         -value          => $encrypted,
     45         -expires        => '+1M',
     46     );
     47 }
     48 
     49 # game play logic
     50 sub process_guess {
     51     my ( $guess, $state ) = @_;
     52 
     53     # process list of previous guesses
     54     my %guessed = map { $_ => 1 } split /,/, $state->{GUESSED};
     55 
     56     # do nothing if user did not enter a guess
     57     return ('', 'continue') unless $guess;
     58 
     59     # ensure guess is a valid number between 1 and 100
     60     return ("Not a valid guess.", 'error')
     61         unless $guess =~ m/^[1-9][0-9]?$|^100$/;
     62 
     63     # check if user already entered this guess previously
     64     return ("You already guessed that number.", 'error')
     65         if $guessed{ $guess };
     66 
     67     # we have a valid guess.  update list of guesses
     68     $guessed{ $guess } = 1;
     69     $state->{GUESSED} = join ',', sort keys %guessed;
     70 
     71     $state->{GUESSES_LEFT}--;
     72 
     73     # the order of the checks is important here.  At this point, it's
     74     # possible that the player has used their last guess.  Therefore,
     75     # we first check whether the guess is correct
     76 
     77     # guess is correct!
     78     if ( $guess == $state->{NUMBER} ) {
     79         $state->{WON}++;
     80         return ("Congratulations! You guessed that the correct number
     81             was $state->{NUMBER}!", 'won');
     82     }
     83 
     84     # if the guess is not correct AND we are out of guesses...
     85     return ("Sorry, you ran out of turns. The number was $state->{NUMBER}.",
     86         'lost') unless ($state->{GUESSES_LEFT} && $guess != $state->{NUMBER});
     87 
     88     # otherwise...
     89     # guess too low
     90     return ("Your guess is too low.", 'continue')
     91         if ( $guess < $state->{NUMBER} );
     92 
     93     # ...or
     94     # guess is too high
     95     return ("Your guess is too high.", 'continue')
     96         if ( $guess > $state->{NUMBER} );
     97 
     98 }
     99 
    100 # html generation subroutines
    101 sub print_header {
    102     my $state = shift;
    103     print $game->header(
    104         -type       => "text/html",
    105         -charset    => 'utf-8',
    106         -cookie     => save_state( $state ),
    107     );
    108     print $game->start_html(
    109         -title      => "Guess a Secret Number!",
    110         -onLoad     => 'if (document.gf) document.gf.guess.focus()'
    111     );
    112     print $game->h1( 'Guess a Secret Number Interactive Game' );
    113 }
    114 
    115 sub print_status {
    116     my ( $message, $state ) = @_;
    117 
    118     # draw table
    119     print
    120         $game->table( { -border=>"0", -width=>"50%" },
    121             $game->Tr(
    122                 $game->td( $game->b("Game #: "), $state->{GAMENO} ),
    123                 $game->td( $game->b("Wins: "),   $state->{WON} )
    124             ),
    125             $game->Tr(
    126                 $game->td( $game->b("Guesses Left: "),    $state->{GUESSES_LEFT} ),
    127                 $game->td( $game->b("Numbers Guessed: "), $state->{GUESSED} )
    128             )
    129         );
    130     print $game->h2( $game->font( {-color => 'red'}, $message ))
    131         if $message;
    132 }
    133 
    134 sub show_restart_form {
    135     my $state = shift;
    136     print $game->start_form();
    137     print $game->p(
    138         #-style => 'padding-right: 25px',
    139         'Do you want to play again?',
    140     );
    141     print $game->submit (
    142         -name  => 'restart',
    143         -value => 'Play again',
    144         #-style => 'padding-left: 25px; padding-right: 25px',
    145     );
    146     print $game->checkbox (
    147         -name  => 'clear',
    148         -label => 'Clear history',
    149     );
    150     print $game->end_form();
    151 }
    152 
    153 sub show_guess_form {
    154     my $state = shift;
    155     print $game->start_form( -name => 'gf' );
    156     print "Your guess: ";
    157     print $game->textfield (
    158         -inputmode     => 'numeric', # force number pad on mobile
    159         -pattern  => '[0-9]*',       # force number pad on mobile
    160         -name     => 'guess',
    161         -value    => '',
    162         -override => 1
    163     );
    164     print $game->submit (
    165         -name     => '_guess',
    166         -value    => 'Guess'
    167     );
    168     print $game->end_form();
    169 }
    170 
    171 sub print_footer {
    172     print $game->hr;
    173     print $game->p(
    174         'inspired by Hangman game from ',
    175         $game->a(
    176             { -href => "https://www.oreilly.com/library/view/writing-apache-modules/156592567X/"},
    177             $game->i( 'Writing Apache Modules with Perl and C')
    178         ),
    179         ' by Lincoln Stein and Doug MacEachern.'
    180     );
    181     print $game->end_html();
    182 }
    183 
    184 # message authentication checks
    185 sub cookie_check {
    186     my ($state, $action) = @_;
    187     return unless ref( $state );
    188     my @fields = @{$state}{qw(NUMBER GUESSES_LEFT GUESSED GAMENO WON)};
    189     my $newmac = MD5->hexhash(
    190         SECRET . MD5->hexhash( join '', SECRET, @fields )
    191     );
    192     return $state->{MAC} = $newmac if $action eq 'generate';
    193     return $newmac eq $state->{MAC} if $action eq 'check';
    194     return undef;
    195 }
    196 
    197 sub authentication_error {
    198     my $cookie = CGI::Cookie->new(-name => COOKIE_NAME, -value=>'',-expires => '-1d');
    199     print $game->header(-cookie => $cookie),
    200           $game->start_html(-title => 'Authentication Error'),
    201           $game->h1($game->font({-color => 'red'}, 'Authentication Error')),
    202           $game->p('This application was unable to confirm the integrity of the',
    203           'cookie that holds your current score.',
    204           'Please reload the page to start a fresh session.'),
    205           $game->p('If the problem persists, contact the webmaster.');
    206     exit 0;
    207 }
    208 
    209 # begin main program
    210 # retrieve current state
    211 my $state = get_state() unless $game->param( 'clear' );
    212 
    213 # initialize state if we are starting from the beginning (!$state)
    214 # or if we are playing another game ($game->param( 'restart' )).
    215 if ( !$state || $game->param( 'restart' ) ) {
    216     $state = initialize( $state );
    217 }
    218 
    219 # process current guess, if any
    220 my ( $message, $status ) =
    221     process_guess( $game->param( 'guess' ) || '', $state );
    222 
    223 # generate the HTML page
    224 print_header( $state );
    225 print_status( $message, $state );
    226 
    227 # prompt user
    228 if ( $status =~ /^(won|lost)$/ ) {
    229     show_restart_form( $state );
    230 } else {
    231     show_guess_form( $state );
    232 }
    233 
    234 print_footer();