这是一个Perl编写的挂人游戏脚本，类似于经典的游戏Hangman。脚本包含游戏逻辑、计分系统和用户界面，使用CGI模块处理HTTP请求。游戏提供有限次数的猜测机会，错误猜测会减少剩余尝试次数。
kernel 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> 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,),
" ",
$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>
~,
$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__翻译自: https://bytes.com/topic/perl/insights/857707-word-guess-game-similar-hangman
kernel hang
扫一扫
435
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
