So, what did we see on our "stroll through Perl"? The list is lengthy and contains items with some sophistication. We
print
statement<STDIN>
to get input from the user
(chomp
ing off the newline character at the end)eq
, ne
, less than
[<
])while
guessing a secret word (also a
foreach
loop)-M
file operator (which tells us the
age in days since a file or filehandle has last been modified)write
each individual's
secret wordopen
ed a file for output (append mode) and print
ed incorrect guesses
(failed attempts) to itrename
d files in a directory
Here then are our final programs.
First, the "say hello" program:
#!/usr/bin/perl -w
&init_words();
print "What is your name? ";
$name = <STDIN>;
chomp ($name);
if ($name =~ /^Larry\b/i) { # regular expression check
print "Hello, Larry! How good of you to be here!\n";
}
else {
print "Hello, $name!\n"; # ordinary greeting
print "What is the secret word? ";
$guess = <STDIN>;
chomp ($guess);
while (! &good_word($name,$guess)) {
print "Wrong, try again. What is the secret word? ";
$guess = <STDIN>;
chomp ($guess);
} # end of while not correct
print "Good guess! Have a great day!!";
}
dbmopen (%last_good,"lastdb",0666);
$last_good{$name} = time;
dbmclose (%last_good);
# subroutines from here down
sub init_words {
while ( defined($filename = glob("*.secret")) ) {
open (WORDSLIST, $filename) || die "can't open $filename: $!";
if (-M WORDSLIST < 7.0) {
while ($name = <WORDSLIST>) {
chomp ($name);
$word = <WORDSLIST>;
chomp ($word);
$words{$name} = $word;
}
}
else { # rename the file so it gets noticed
rename ($filename,"old.$filename") || die "can't rename $filename to old.$filename: $!";
}
close (WORDSLIST) || die "couldn't close $filename: $!";
}
}
sub good_word {
my($somename,$someguess) = @_; # name the parameters
$somename =~ s/\W.*//; # zap everything after the first word
$somename =~ tr/A-Z/a-z/; # lowercase everything
if ($somename eq "larry") { # should not need to guess
return 1; # return value is true
}
elsif (($words{$somename} || "mfd") eq $someguess) {
return 1; # return value is true
}
else {
&log_failure($somename, $someguess);
return 0; # return value is false
}
}
sub log_failure {
my($somename,$someguess) = @_; #name the parameters
open(LOG, ">>failures.log") || die "Can't open failures.log: $!";
print LOG "bad news: $somename guessed $someguess\n";
close (LOG) || die "Can't close failures.log: $!";
}
Next, we have the secret word lister:
#!/usr/bin/perl -w
while (defined($filename = glob("*.secret"))) {
open (WORDSLIST, $filename) || die "can't open $filename: $!";
if (-M WORDSLIST < 7.0) {
while ($name = <WORDSLIST>) {
chomp ($name);
$word = <WORDSLIST>;
chomp ($word);
write; # invoke format STDOUT to STDOUT
}
}
close (WORDSLIST) || die "couldn't close $filename: $!";
}
format STDOUT =
@<<<<<<<<<<<<<<< @<<<<<<<<< @<<<<<<<<<<<
$filename, $name, $word
.
format STDOUT_TOP =
Page @
$%
Filename Name Word
================ ========== ============
.
And finally, the last-time-a-secret-word-was-guessed reporting program:
#!/usr/bin/perl -w
dbmopen (%last_good,"lastdb",0666) || die "can't dbmopen lastdb: $!";
foreach $name (sort keys (%last_good)) {
$when = $last_good{$name};
$hours = (time() - $when) / 3600; # compute hours ago
write;
}
format STDOUT =
User @<<<<<<<<<<: last correct guess was @<<< hours ago.
$name, $hours
.
In our last lesson for this module, we'll take a look at some perl code snippets from the MFD and T&C "toolkits".
See you next lesson!