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_number2.cgi (5472B) - raw


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