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_number.cgi (5285B) - raw


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