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