猜词游戏（类似于Hang子手）

这不是“ Howto”文章，而是完整的脚本。 几年前，我为另一个论坛的比赛写了这个脚本，从那以后它真的只是在收集灰尘。
如果您不了解某些代码，请询问有关脚本如何工作的问题。 这并非旨在提供技术支持，而是出于学习目的。 毫无疑问，可以对代码进行改进，因此，如果您发现有使自己感到胆怯的话题，可以随意讨论。 这应该是CGI脚本以及如何使用CGI模块和其他几个核心模块的一个很好的例子。
我希望它可以用作学习工具，但是如果有人想将其发布在网站上供访问者使用，那就可以了。
没有对该脚本的支持，但是如果您尝试使用它并使其无法运行，我可能会尝试通过此论坛为您提供帮助。 但是，我不会尝试并尝试帮助您使其运行。 如果在提出一些建议后仍无法正常工作，我将不再提供帮助。
附带有一个单词文件，该单词文件多于2,000个单词，难于猜测。 一个文件具有按字母顺序排列的单词，另一个文件words.dat是用于游戏的文件。 单词以随机顺序排列，并以空格分隔，这是脚本编写所希望找到的空格。 不应有粗俗的词，但您不妨检查一下。
由于该论坛不允许上传.pl文件，因此将perl脚本附加为wordguess.txt。 如果使用该文件，只需将名称更改为wordguess.pl
问候，
凯文

#!/usr/bin/perl -T 
######################################################
# Wordguess Game, similar to Hangman
# Kevin Ruggles 2004
# There is no help or tech support for this script.
# Use at your own risk.
# Edit and distribute as you like.
# See comments in script for hints on how to set it up
# or to change stuff.
######################################################   
####################################
####  script environment stuff  ####
####  do not edit unless you    ####
####  know what you are doing!  ####
####################################
use CGI qw(-no_xhtml);
#use CGI::Carp qw(fatalsToBrowser);
$CGI::POST_MAX = 128;  # max 128 byte posts, we don't need much for this script so keep it low
$CGI::DISABLE_UPLOADS = 1;  # no uploads, to prevent funny business
use Fcntl;
use Tie::File;
use strict;
use warnings; 
##########################################################
####  Paths to files                                  ####
####  Should be above the web root folder.            ####
####  Create a folder and name it hangman.            #### 
####  Put the words.txt file in it.                   ####
####  Change "/home/yoursite" to work on your website ####
##########################################################
my $path_words = '/home/yoursite/hangman/words.txt';
my $path_games = '/home/yoursite/hangman/data/'; 
########################################################
####  scoring data - you can edit them if you like  ####
########################################################
my @v = q(3 7 10 15);
my %points = (
   a=>$v[0],e=>$v[0],i=>$v[0],o=>$v[0],u=>$v[0],
   b=>$v[1],c=>$v[1],d=>$v[1],f=>$v[1],g=>$v[1],
   h=>$v[1],l=>$v[1],m=>$v[1],n=>$v[1],p=>$v[1],
   r=>$v[1],s=>$v[1],t=>$v[1],
   j=>$v[2],k=>$v[2],y=>$v[2],
   v=>$v[3],q=>$v[3],w=>$v[3],x=>$v[3],z=>$v[3]
); 
############################################################
####  Appearance stuff - you can edit them if you like. ####
####  The code is CSS and is inserted as an inline      ####
####  style sheet or directly into html tags. Its up to ####
####  you to figure it out.                             ####
############################################################
my $body_definitions = qq(
body {
   background-color:#C0C0FF;
   font-family:Verdana;
   font-size:16px;
}
input {
   font-family:Verdana;
   font-size:12px;
   font-weight:bold;
   background-color:#C0C0FF;
   border:solid 1px #0000C0;
}
);
my $div_enter_page = qq(background-color:#D4D5EC; text-align:center; width:400px; padding:8px 5px 0 5px; border:solid 1px #0000C0; margin-top: 15%; margin-left: auto; margin-right: auto;);
my $div_style = qq(background-color:#D4D5EC; text-align:center; width:480px; padding:8px 0 0 0; border:solid 1px #0000C0; margin-top: 15%; margin-left: auto; margin-right: auto;);
my $H1 = qq(font-family:Arial; font-size:24px;);
my $rules = qq(font-size:10pt;width:100%;text-align:left;padding:0 5px 0 5px;);
my $secret_word_span = qq(color:#0000C0;letter-spacing:5px;font-size:24px;font-weight:bold;font-family:Courier;);
my $text_field = qq(background-color:cornsilk;text-align:center;); 
########################################################
####  game options - you can edit them if you like  ####
########################################################
# maximum number of incorrect tries
my $max_tries = 10; 
# maximum amount of time in seconds to complete a game (60 = 1 minute, etc)
# set to zero '0' or leave blank '' to NOT have a time limit.
my $max_time = 60; 
# the number of days until old games that were not deleted by the script during play
# will be deleted, the minimum value is one '1' (one day more or less).
# set to zero '0' or leave blank '' to NOT auto delete old game files.
my $delete = 1; 
##############################################
####  you should not edit below here      ####
####  unless you know what you are doing! ####
##############################################
my $q = new CGI;
print $q->header(); 
my ($flag,$t,%h,$id) = (0,time,'',''); 
if ($q->param('new_game') || $q->param('start_game') || $q->param('submit') || $q->param('hint')) {
   GetData();
   my $this_guess = ProcessData() unless $q->param('new_game') || $q->param('start_game');
   Win()  if ($h{'word'} eq $h{'revealed'} && $h{'tries_left'} <= $max_tries);
   Lose() if ($t >= $h{'time'} && $max_time);
   Lose() if ($h{'tries_left'} < 1 && $this_guess);
   PrintGame();
   PrintData();
   AutoDelete() if $delete;
}
else {Enter()}
exit(0);
########################################
####  normal termination of script  ####
######################################## 
#######################
####  subroutines  ####
#######################
sub AutoDelete {
   $path_games .= '/' unless $path_games =~ m/\/$/; # make sure we have the trailing slash
   my @games = <$path_games*.game>;
   for (@games) {
        if (/$path_games([\w]{20})\.game/) {# untaint the path
           my $game = "$path_games$1.game";
         unlink($game) if (int(-M $game) >= $delete);
      }
      else {next;}
   }
} 
sub DeleteOld {
   my $old_id = shift;
   die "Unable to continue.\n" unless ($old_id =~ m/^([\w.-]+)$/); #untaint $old_id
   $old_id = "$path_games$1.game";
   unlink($old_id);
   undef $old_id;
} 
sub EndHTML {
   print $q->start_form(-name=>'hangman'),
         $q->submit (-name=>'new_game', -label=>'Play Again'),
         $q->end_form,
         "\n</div>\n",
         $q->end_html;
   exit(0);
} 
sub Enter {
   my $the_time = 'run out.';
   $the_time = 'run out or the time runs out.' if $max_time;
   my $the_time2 = '';
   $the_time2 = "and $max_time seconds" if $max_time;
   print $q->start_html(-title=>'Word Guess / Hangman!',-style=>"$body_definitions",-onLoad=>'document.hangman.start_game.focus()'),
         qq~
<div style="$div_enter_page">
   <h1 style="$H1">Lets Play Word Guess (Hangman)!</h1>
      <div style="$rules">
         <b>&nbsp;&nbsp;&nbsp;The Rules:</b>
            <ol>
                <li>Guess letters to reveal the secret word.</li>
                <li>You win if you guess the secret word before your tries remaining $the_time</li>
                <li>You have $max_tries tries $the_time2 to start with.</li>
                <li>An incorrect guess will take away one try.</li>
                <li>A correct guess will not take away from your $max_tries tries but does add to your total tries.</li>
            </ol>
      </div>
~,
         $q->start_form(-name=>'hangman'),
         $q->submit(-name=>'start_game', -label=>'Start Game'),
         $q->end_form,
         "\n</div>\n",
         $q->end_html;
} 
sub GetData {
   if($q->param('new_game') || $q->param('start_game')) {
      &DeleteOld($q->param('gameid')) if $q->param('gameid');
      $id = &MakeGameId();
      $id = &MakeGameId() if (-e "$path_games$id.game"); #just to be safe
      tie my @DATA, 'Tie::File', $path_words, recsep => ' ', mode => O_RDWR || die print "<h2>$!</h2>\n";
      print "<h1>There are no words. Please upload the words.dat file</h1>" unless @DATA;
      my $word = lc $DATA[int(rand @DATA)];
      untie(@DATA);
      ($h{'hints'},$h{'total'},$h{'word'},$h{'tries_left'},$h{'letters'},$h{'time'}) = (0,0,$word,$max_tries,'',($t+$max_time));
      ($h{'revealed'} = $word) =~ tr/a-z/_/; 
      open(GAME, ">$path_games$id.game") or die print "<h2>Can't find game file: $!</h2>\n";
      print(GAME "$h{'time'}\t$h{'hints'}\t$h{'hint_letters'}\t$h{'total'}\t$h{'word'}\t$h{'tries_left'}\t$h{'letters'}\t$h{'revealed'}");
   }
   else {
      $id = $q->param('gameid');
      die "Unable to continue.\n" unless ($id =~ m/^([\w.-]+)$/); #untaint $id
      $id = $1;
      open(GAME, "$path_games$id.game") or die print "<h2>Can't find game file: $!</h2>\n";
      ($h{'time'},$h{'hints'},$h{'hint_letters'},$h{'total'},$h{'word'},$h{'tries_left'},$h{'letters'},$h{'revealed'}) = split(/\t/,<GAME>);
   }
   close(GAME);
} 
sub GuessLetter {
   my $guess = shift;
   my @word = split(//,$h{'word'});
   my @new_revealed = split(//,$h{'revealed'});
   my ($pass,$count) = (0,0);
   foreach (@word) {
      ($pass,$new_revealed[$count]) = (1,$guess) if ($guess eq $_);
      $count++;
   }
   $h{'revealed'} = join("",@new_revealed);
   return $pass;
} 
sub Hint {
   my $bonk = 0;
   my @word = split(//,$h{'word'});
   my $hint = lc $word[int(rand @word)];
   my %revealed = map {$_ => $_} split(//,$h{'revealed'});
   $bonk++ if $hint eq $revealed{$hint};
   if ($bonk) {&Hint;}
   else {return $hint;}
} 
sub Lose {
   &DeleteOld($q->param('gameid'));
   my ($score,$max_score) = &Score();
   my $effort = '';
   $effort = 'that sucked'  if $score < 1;
   $effort = 'good try'     if $score > 0;
   $effort = 'time ran out' if ($t > $h{'time'} && $max_time);
   print $q->start_html(-title=>'Word Guess / Hangman - Sorry!',-style=>"$body_definitions",-onLoad=>'document.hangman.new_game.focus()'),
         qq~
<div style="$div_style">Sorry, $effort, the secret word was:<p>
   <span style="$secret_word_span">$h{'word'}</span><p>
   Your score was <b>$score</b> of a possible <b>$max_score</b> points.
   <br>
~;
  &EndHTML;
} 
sub MakeGameId {
   my @digits = ('a'..'z', 'A'..'Z', '0'..'9');
   $id .= $digits[int(rand @digits)] for (1..10);
   return ($id.time);
} 
sub PrintData {
   open(GAME, ">$path_games$id.game") || die "$!\n";
   print(GAME "$h{'time'}\t$h{'hints'}\t$h{'hint_letters'}\t$h{'total'}\t$h{'word'}\t$h{'tries_left'}\t$h{'letters'}\t$h{'revealed'}");
   close(GAME);
} 
sub PrintGame {
   my ($time_limit,$color,$t_color) = ('','#000000','#000000');
   if ($h{'tries_left'} < 3) {$color = '#FF0000';}#alert when 2 tries remain
   my $time_left = ($h{'time'} - $t);
   my $t_percent = int($max_time * .2);
   if ($time_left <= $t_percent) {$t_color = '#FF0000';}#alert when %20 of time remains
   $time_limit = qq~Time Remaining: <span style="color:$t_color;font-weight:bold;">$time_left sec</span><br>~ if ($max_time);  
   print $q->start_html( -title=>'Word Guess / Hangman!',-style=>"$body_definitions",-onLoad=>'document.hangman.guess.select()'),
         qq~
<div style="$div_style">
   <span style="font-size:20px;font-weight:bold;">Secret Word: </span>
   <span style="$secret_word_span">$h{'revealed'}</span>
   <p>
~,
         $q->start_form(-name=>'hangman'),
         "Enter a guess: ",
         $q->textfield ( -name=>'guess', -size=>1, -maxlength=>1, -default=>'', -style=>"$text_field", override=>1,),
         "&nbsp;",
         $q->hidden (-name=>'gameid', -default=>$id, override=>1),
         $q->submit (-name=>'submit', -label=>'Submit Guess'),
         qq~
   <p>Tries Remaining: 
   <span style="color:$color;font-weight:bold;">$h{'tries_left'}</span>
   <br>$time_limit
   Total Tries: <b>$h{'total'}</b>
   <br>
   Incorrect Guesses: <b style="letter-spacing:6px;">$h{'letters'}</b>
   <p>
   &nbsp;&nbsp;
~,
         $q->submit(-name=>'hint', -label=>'Hint'),
         "\n   <span style=\"font-size:16px;\"> * </span><p>\n",
         $q->submit(-name=>'new_game', -label=>'New Game'),
         "\n   <p>\n",
         $q->end_form,
         qq~\n   <span style="font-size:10px;">* Takes away 2 tries remaining and adds 2 to total tries.<br>* No points awarded for hints.</span>\n</div>\n~,
         $q->end_html;
} 
sub ProcessData {
   my $this_guess = $q->param('guess');
   $this_guess = &Hint if $q->param('hint');
   $this_guess =~ tr/a-zA-Z//cd; #we only want a-z
   $this_guess = substr $this_guess,0,1; #we only want one character
   if ($this_guess) {
      $h{'total'}++;
      ($h{'tries_left'}-=2,$h{'total'}++,$h{'hints'}++,$h{'hint_letters'} .= $this_guess) if $q->param('hint');
      unless (&GuessLetter($this_guess)) {
         $h{'tries_left'}--;
         $h{'letters'} .= $this_guess;
      }
      return($this_guess);
   }
   else {return(0);}
} 
sub Score {
   # the scoring system is very simple and only intended for fun
   # the basic concept is:
   #   1. each unique letter in a word is given a points value (%points)
   #   2. any letters revealed by using the hint button are not awarded points.
   #   3. the total points are added up and multiplied by the number of tries remaining if any.
    $h{'tries_left'} = 1 if $h{'tries_left'} < 1;
   my ($score,$score2,$max_score) = (0,0,0);
   my %guess = map {$_ => $_ } split(//,$h{'revealed'});
   my %word  = map {$_ => $_ } split(//,$h{'word'});
   my %hints = map {$_ => $_ } split(//,$h{'hint_letters'});
   for (keys %guess) {
        $guess{$_} = 0 if $_ eq $hints{$_};
   }
   $score+=$points{$_}  for values %guess;
   $score2+=$points{$_} for keys %word;
   $max_score = $score2*$max_tries;  # maximum possible score
print qq~   $score = $score*$h{'tries_left'}; # actual score~;
   $score = $score*$h{'tries_left'}; # actual score
   return ($score,$max_score);
} 
sub Win {
   my $time_used = $max_time - ($h{'time'} - $t);
   my $time_stat = '';
   $time_stat = qq~<br>Time: <b>$time_used sec</b>~ if ($max_time);  
   &DeleteOld($q->param('gameid'));
   my ($score,$max_score) = &Score();
   my $congrats = 'Congratulations!';
   $congrats .= ' Perfect Score!' if $score == $max_score;
   print $q->start_html(-title=>'Word Guess / Hangman - Congratulations!',-style=>"$body_definitions",-onLoad=>'document.hangman.new_game.focus()'),
         qq~
<div style="$div_style">
   $congrats<br>You guessed the secret word:
   <p>
   <span style="$secret_word_span">$h{'word'}</span>
   <p>
   Total Guesses: <b>$h{'total'}</b>
   $time_stat
   <p>
   Your score was <b>$score</b> of a possible <b>$max_score</b> points.
   <br>
~;
   &EndHTML;  
}
__END__

附加的文件

	words.txt （15.1 KB，767次观看）
	words_abc_order.txt （17.4 KB，721视图）
	wordguess.txt （13.6 KB，598视图）

From: https://bytes.com/topic/perl/insights/857707-word-guess-game-similar-hangman