Ubuntu

game-hangman

Registered by subliminalfix

# hangman.cgi

##need wordlist or txt doc such as ie.

chihuahua

ostrich

chimp

cookie

perl

weasel

plastic

bonus

scissors

dynamite

#!/usr/bin/perl -wT

$| = 1; # don't buffer output

$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin:';

$ENV{'SHELL'} = '/bin/sh';

$ENV{'ENV'} = '';

$ENV{'IFS'} = '';

use lib '/path/to/library';

use Taintcheck;

use CGI;

use SDBM_File;

use Fcntl;

use FreezeThaw qw(freeze thaw); # to store game state in DBM file

use strict;

use vars qw($CGI $__START__ $WORDS

            $SESSIONS $GALLOWS $BODY_PARTS);

# GLOBALS

$CGI = 'hangman.cgi';

$WORDS = '/path/to/words'; # your words file

$SESSIONS = '/path/to/games'; # game sessions dbm

$GALLOWS = '/path/to/gallows/images'; # gallows images

$BODY_PARTS = 7; # number of images

# MAIN

eval{ main(); }; $__START__ = __LINE__;

# ERRORS

if ($@) {

  chomp($@);

  $@ =~ s/\(eval\) line (\d+)/${CGI} .

        " line " . ($__START__-$1-1)/e;

  $@ =~ s/( at ).*( line )/$1${CGI}$2/;

  my $error_message = $@;

  print <<ERR;

Content-type: text/html

<hmtl>

  <head><title>Error</title></head>

  <body>

    <h1>Error</h1>

    <code>$error_message</code>

  </body>

</html>

ERR

}

# SUBROUTINES

sub main {

  my $q = new CGI;

  untaint_params($q);

  my $game;

  # No input? must be a new game

  unless ($q->param) {

    new_game($q);

    return;

  }

  # we also want to provide a way to start a new game

  # explicitly

  if ($q->param('submit') =~ /new game/i) {

    $q->delete_all(); # clear all params

    &new_game($q);

  } elsif ($q->param('session_id')) {

    # try to restore the past game state

    die "Game id out of date or incorrect (" .

        ($q->param('session_id')) .

        "). Please start a new game."

          unless ($game = restore_game($q->param('session_id')));

    continue_game($game,$q);

  } else {

    # something has gone wrong -- probably bad input

    die "No game id submitted. Please start a new game.";

  }

}

# restore_game

#

# given a session id, load the session record

# from the DBM file, and restore the game state

sub restore_game {

  my $id = shift;

  my (%sessions, %game);

  return unless $id;

  tie(%sessions, 'SDBM_File', $SESSIONS, O_RDONLY, 0666)

    || die "Could not open game session data";

  return unless $sessions{$id};

  %game = thaw($sessions{$id});

  return unless ($game{'word'} && $game{'status'});

  return \%game;

}

# continue_game

#

# append the new guess to the guess list,

# save the new game state, and produce

# the correct output page

sub continue_game {

  my $game = shift;

  my $q = shift;

  my ($id,$tmp,$g);

  eval {

    if ((ref $q) && ($q->param)) {

      if ($q->param('guess')) {

         $g = $q->param('guess');

         # here's another way of finding out if

         # a value is a member of an array

         $tmp = ':' . join(':', @{$game->{'guesses'}}) . ':';

         die "You already guessed $g!" if ($tmp =~ /:$g:/i);

           push @{$game->{'guesses'}}, $g;

         # now the fun part -- did we win, lose,

         # match, or mismatch?

         $game->{'status'} = take_turn($game);

         # save state for next time

         save_game_state($q->param('session_id'),$game);

         # and output results

         draw_game_page($q,$game);

      } else {

         # nothing was guessed, just echo back the last page

         draw_game_page($q,$game);

      }

    } else {

      $id = save_game_state(undef, $game);

      draw_game_page($q, $game, $id);

    }

  };

  if ($@) {

    chomp($@);

    gameplay_error($q,$@);

  }

}

sub save_game_state {

  my $session_id = shift;

  my $game_state = shift;;

  my (%sessions);

  tie(%sessions, 'SDBM_File', $SESSIONS, O_CREAT|O_RDWR, 0666)

    || die "Failed to open game sessions data";

  unless ($session_id) {

    $session_id = time;

    while ($sessions{$session_id}) {

      $session_id++;

    }

  }

  $sessions{$session_id} = freeze(%$game_state);

  untie %sessions;

  return $session_id;

}

# new_game

#

# pick a random word from the words file,

# and generate a new session id and a new

# record in the sessions DBM file

sub new_game {

  my $q = shift;

  my (%game);

  $game{'word'} = pick_word();

  $game{'status'} = 'new';

  $game{'guesses'} = [];

  &continue_game(\%game, $q);

}

sub take_turn {

  my $game = shift;

  # remove good guesses from word

  # and from $game->{'guesses'}

  my ($word, @guesses, $bad_guesses);

  @guesses = @{$game->{'guesses'}};

  $word = $game->{'word'};

  foreach my $g (@guesses) {

    if (length($g) == 1) {

      # if the guess matches, remove each instance

      # from the word. Otherwise, add 1 to bad guesses

      unless($word =~ s/$g//gi) {

         $bad_guesses++;

      }

    } else {

      # if a guess is longer than one character,

      # if must match the whole word to count

      # we compare it with the original copy of the

      # word, in case other letters have been removed

      if ($game->{'word'} =~ /^$g$/i) {

         $word = '';

      } else {

         $bad_guesses++;

      }

    }

  }

  if (! $word ) {

    # if word is empty, you win!

    return 'won';

  } elsif ($bad_guesses >= $BODY_PARTS) {

    # if count of bad guesses >= number of body parts,

    # you lose.

    return 'lost';

  }

  return 'playing';

}

sub draw_game_page {

  my $q = shift;

  my $game = shift;

  my $id = shift || $q->param('session_id');

  my ($title, $word, $url, $guesses, $g, $msg,

      $gallows, @tmp, $turns, $parts, $length,

      $tmp, $char);

  if ($game->{'status'} eq 'won') {

    # we have a winnah!

    draw_win_page($q,$game);

  } elsif ($game->{'status'} eq 'lost') {

    # oh well...

    draw_loss_page($q,$game);

  } else {

    # some turn in the middle

    $url = $q->url;

    $turns = 1;

    $length = length($game->{'word'});

    $parts = 0;

    if (@{$game->{'guesses'}}) {

      $turns = scalar @{$game->{'guesses'}} + 1;

      $title = "Hangman - turn $turns";

      # make the guesses line look nice

      # with green for good, red for bad

      foreach $g(@{$game->{'guesses'}}) {

         if (((length($g) == 1) && ($game->{'word'} =~ /$g/i))

            || ($game->{'word'} =~ /^$g$/i)) {

           push @tmp, "<font color=\"darkgreen\">$g</font>";

         } else {

           push @tmp, "<font color=\"red\">$g</font>";

           $parts++;

         }

      }

      $guesses = join(', ', @tmp);

      # tell the player whether their last guess

      # was right or wrong

      $g = $game->{'guesses'}->[ $#{$game->{'guesses'}} ];

      $msg = "Last guess: ";

      if (((length($g) == 1) && ($game->{'word'} =~ /$g/i))

        || ($game->{'word'} =~ /^$g$/i)) {

         $msg .= "<b><font color=\"darkgreen\">$g</font></b>";

      } else {

         $msg .= "<b><font color=\"red\">$g</font></b>";

      }

      # draw the word, with " _ " in place of

      # unguessed letters

      $tmp = ':' . join(':', @{$game->{'guesses'}}) . ':';

      # see if the whole word has been guessed

      if ($tmp =~ /:$game->{'word'}:/i) {

         $word = join(" ", split(//,$game->{'word'}));

      } else {

        # go through the word character by character,

        # seeing if each has been guessed

        my @word = split(//, $game->{'word'});

        foreach $char(@word) {

          $char = uc($char);

          if ($tmp =~ /:$char:/i) {

            $word .= " $char ";

          } else {

            $word .= " _ ";

          }

        }

     }

   } else {

      # this is their first turn

      $title = "Welcome to Hangman!";

      $guesses = "<i>none</i>";

      $length = length($game->{'word'});

      $word = " _ " x $length;

      $turns = 0;

      $msg = '';

      $parts = 0; # the gallows itself

    }

    print $q->header;

    print <<GAME;

<html>

<head><title>$title</title></head>

<body bgcolor="white">

<h1>$title</h1>

<img src="$GALLOWS/gallows_$parts.gif" align="left"/>

<br/>

<p><font size=+1>$msg</font></p>

<p><font size=+1><b>$word</b></font></p>

<p>Guessed so far: $guesses</p>

<form action="$url" method="post">

<input type="hidden" name="session_id" value="$id"/>

<p>Next guess: <input type="text" name="guess" size="$length"

maxchars="$length"/></p>

<p><input type="submit" name="submit" value="Guess!" default/>

   <input type="submit" name="submit" value="New Game"/></p>

</form>

</body>

</html>

GAME

  }

}

sub draw_win_page {

  my $q = shift;

  my $game = shift;

  my ($word, $turns, $url, $min);

  $word = $game->{'word'};

  $turns = scalar @{$game->{'guesses'}};

  $url = $q->url;

  $min = (time - $q->param('session_id')) / 60;

  print $q->header;

  print <<VICTORY;

<html>

<head><title>You win!</title></head>

<body bgcolor="white">

  <h1>Congratulations!</h1>

  <p> You correctly guessed the word <b>$word</b>

      in <b>$turns</b> tries,

      and it only took you <b>$min</b> minutes!</p>

  <p> <a href="$url">Click here</a> to play again.</p>

</body>

</html>

VICTORY

}

sub draw_loss_page {

  my $q = shift;

  my $game = shift;

  my $word = $game->{'word'};

  my $url = $q->url;

  print $q->header;

  print <<DEFEAT;

<html>

<head><title>You lose!</title></head>

<body bgcolor="white">

  <h1>Too bad!</h1>

  <img src="$GALLOWS/dead.gif" align="left"/>

  <p> You're dead. The word was: <b>$word</b><p>

  <p> <a href="$url">Click here</a> to play again.</p>

</body>

</html>

DEFEAT

}

sub pick_word {

  my (@words, $word);

  open (WRDS, "<$WORDS")

    || die "Could not open words file $WORDS";

  @words = <WRDS>;

  close WRDS;

  $word = $words[ rand @words ];

  chomp($word);

  return $word;

}

sub gameplay_error {

  my $q = shift;

  my $err = shift;

  my $url = $q->url;

  my $id = $q->param('session_id');

  # chop off the line number

  $err =~ s/at .*line.*$//;

  print $q->header;

  print <<GAME_ERR;

<html>

<head><title>Uh oh...</title></head>

<body bgcolor="white">

<h1>Uh oh!</h1>

<p> $err </p>

<p><b><a href="$url?session_id=$id">Back to the game!</b></a></p>

</body>

</html>

GAME_ERR

}

Blueprint information

Status:
Started
Approver:
None
Priority:
Undefined
Drafter:
None
Direction:
Needs approval
Assignee:
None
Definition:
New
Series goal:
None
Implementation:
Needs Code Review
Milestone target:
None
Started by
subliminalfix

Sprints

Whiteboard

ivy rain stafford: submitted

rainy rain

Joel, my scripting skills are not beyond "hello world" so I'm not sure what I can do.

(?)

Work Items

This blueprint contains Public information 
Everyone can see this information.