A Stroll Through Perl - Summary

So, what did we see on our "stroll through Perl"?  The list is lengthy and contains items with some sophistication.  We

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!