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();