Ling 483/783
Sample Perl Programs
#!/usr/local/bin/perl
# fig74.pl
# produces a table using CGI package
use warnings;
use strict;
use CGI qw( :standard );
print header(), start_html( "Environment Variables" );
print '<table border = "0" cellspacing = "2">';
foreach my $variable ( sort( keys %ENV ) ) {
print Tr( td( b( "$variable:" ) ),
td( i( $ENV{ $variable } ) ) );
}
print '</table>', end_html();
#!/usr/local/bin/perl
# clue2.pl
# This program responds to possession and location queries
# It ends when the user types "thanks"
# It uses the hashes @weapon and @room to keep track of the objects
%weapon = (); %room = ();
# Block 1. Read in data file
open ITEMS, "< clue.txt";
while (chop( $input = <ITEMS> )) {
($name, $weap, $rm) = split /\t/, $input;
$weapon{$name} = $weap; $room{$name} = $rm;
print "$name, $weapon{$name}, $room{$name}.\n";
} # end while
# Block 2. Request a prompt from the user
print "Hello Dave. What can I do for you? \n";
chop( our $question = <> ); #Get the question from the standard input
$question = lc $question;
# Main program loop
until ( $question eq 'thanks' ) {
if ( question($question) ) { #Answers the questions
print "$response";
}
else {
print "I don\'t understand that question. Ask a different question.\n";
}
chop( $question = <> ); #Get another question from the standard input
$question = lc $question;
} #End main loop
#######################Subroutines#######################
sub question {
#Test 1. See if question is 'Where is someone?'
if ( $question =~ m/where is (\w+)/ ) {
$response = "$1 is in the $room{$1}.\n";
} #end Test 1
#Test 2. See if question is 'What does someone have?'
elsif ( $question =~ m/what does (\w+) have/) {
$response = "$1 has the $weapon{$1}.\n";
} #end Test 2
#Test 3. See if question is ‘Is someone in somewhere with something?'
elsif ( $question =~ m/is (\w+) in the (\w+) with (a|the) (\w+)/ ) {
if ($2 eq $room{$1} and $4 eq $weapon{$1}) {
$response = "Yes, $1 is in the $2 with a $4\n";
}
elsif ($2 eq $room{$1}) {
$response = "Well, $1 is in the $2.\n";
}
else {
$response = "No, $1 is not in the $2.\n";
}
} #end Test 3
} # end sub question
#!/usr/local/bin/perl
# clue3.pl
# This program responds to possession and location queries
# It ends when the user types "thanks"
# It uses the hashes @weapon and @room to keep track of the objects
# It replaces subroutines with the Question package
use Question;
our $response = '';
# Block 2. Request a prompt from the user
print "Hello Dave. What can I do for you? \n";
chop( our $question = <> ); #Get the question from the standard input
$question = lc $question;
# Main program loop
until ( $question eq 'thanks' ) {
if ( question($question) ) { #Answers the questions
print "$response";
}
else {
print "I don\'t understand that question. Ask a different question.\n";
}
chop( $question = <> ); #Get another question from the standard input
$question = lc $question;
} #End main loop
#!/usr/local/bin/perl
# Question.pm
# Responds to clue3.pl
# It uses the hashes @weapon and @room to keep track of the objects
package Question;
use Exporter;
our @ISA = qw( Exporter );
our @EXPORT = qw( &question $response );
my %weapon = (); my %room = ();
# Block 1. Read in data file
open ITEMS, "< clue.txt" ;
while (chop( $input = <ITEMS> )) {
(my $name, my $weap, my $rm) = split /\t/, $input;
$weapon{$name} = $weap; $room{$name} = $rm;
print "$name, $weapon{$name}, $room{$name}.\n";
} #end while
sub question {
my $query = shift();
#Test 1. See if question is 'Where is someone?'
if ( $query =~ m/where is (\w+)/ ) {
$response = "$1 is in the $room{$1}.\n";
} #end Test 1
#Test 2. See if question is 'What does someone have?'
elsif ( $query =~ m/what does (\w+) have/) {
$response = "$1 has the $weapon{$1}.\n";
} #end Test 2
#Test 3. See if question is ‘Is someone in somewhere with something?'
elsif ( $query =~ m/is (\w+) in the (\w+) with (a|the) (\w+)/ ) {
if ($2 eq $room{$1} and $4 eq $weapon{$1}) {
$response = "Yes, $1 is in the $2 with a $4\n";
}
elsif ($2 eq $room{$1}) {
$response = "Well, $1 is in the $2.\n";
}
else {
$response = "No, $1 is not in the $2.\n";
}
} #end Test 3
} # end sub question
1;
#!/usr/local/bin/perl
# clue4.pl
# This program responds to possession and location queries
# It ends when the user types "thanks"
# It uses the hashes @weapon and @room to keep track of the objects
# It replaces subroutines with the Question2 package
use Question2;
our $response = '';
my %weapon = (); my %room = ();
# Block 1. Read in data file
open ITEMS, "< clue.txt" ;
while (chop( $input = <ITEMS> )) {
(my $name, my $weap, my $rm) = split /\t/, $input;
$weapon{$name} = $weap; $room{$name} = $rm;
print "$name, $weapon{$name}, $room{$name}.\n";
} #end while
# Block 2. Request a prompt from the user
print "Hello Dave. What can I do for you? \n";
chop( our $question = <> ); #Get the question from the standard input
$question = lc $question;
# Main program loop
until ( $question eq 'thanks' ) {
if ( question($question, \%weapon, \%room) ) { #Answers the questions
print "$response";
}
else {
print "I don\'t understand your question.\n";
}
chop( $question = <> ); #Get another question from the standard input
$question = lc $question;
} #End main loop
#!/usr/local/bin/perl
#Question2.pm
# for clue4.pl
#no hashes!
package Question2;
use Exporter;
our @ISA = qw( Exporter );
our @EXPORT = qw( &question $response );
sub question {
my $query = $_[0];
my %weapon = %{$_[1]};
my %room = %{$_[2]};
#Test 1. See if question is 'Where is someone?'
if ( $query =~ m/where is (\w+)/ ) {
$response = "$1 is in the $room{$1}.\n";
} #end Test 1
#Test 2. See if question is 'What does someone have?'
elsif ( $query =~ m/what does (\w+) have/) {
$response = "$1 has the $weapon{$1}.\n";
} #end Test 2
#Test 3. See if question is ‘Is someone in somewhere with something?'
elsif ( $query =~ m/is (\w+) in the (\w+) with (a|the) (\w+)/ ) {
if ($2 eq $room{$1} and $4 eq $weapon{$1}) {
$response = "Yes, $1 is in the $2 with a $4\n";
}
elsif ($2 eq $room{$1}) {
$response = "Well, $1 is in the $2.\n";
}
else {
$response = "No, $1 is not in the $2.\n";
}
} #end Test 3
} # end sub question
return 1;
#!/usr/local/bin/perl
# clue5.pl
# This program responds to possession and location queries
# It ends when the user types "thanks"
# It uses packages to simplify the main program section
use Question4;
# Block 1. Initialize settings
my %weapon = (); my %room = ();
my $computer = "hall";
my @perp = ("mustard", "plum", "scarlet", "peacock", "white", "green");
my @weap = ("knife", "candlestick", "revolver", "rope", "lead_pipe", "wrench");
my @rm = ("kitchen", "billiard_room", "conservatory", "library", "lounge", "dining_room", "study", "ballroom");
# Pick the culprit, weapon and room
my $who = $perp[ rand @perp ];
my $what = $weap[ rand @weap ];
my $where = $rm[ rand @rm ];
# Assign characters and weapons to random rooms
fisher_yates_shuffle( \@rm );
fisher_yates_shuffle( \@weap );
foreach $perp ( @perp ) {
$room{$perp} = $rm[$i];
$weapon{$perp} = $weap[$i];
$i = $i + 1;
} # end foreach $perp
# Block 3. Display the initial room setting
print "\nGood evening Chief Inspector.\n";
print "\nI am Jeeves, the head butler. I'm sorry you had to come\n";
print "out on a night like this. I'm afraid someone in the house\n";
print "has committed a murder and we need you to solve the crime.\n";
print "The mansion contains nine rooms.\n";
print "We are presently standing in the hall.\n";
print "To our right are the study, the library, the billiard_room and the lounge.\n";
print "To our left are the ballroom, the conservatory, the dining_room and the kitchen.\n";
print "I will be happy to show you around the house and\n";
print "introduce you to our guests.\n";
print "Which room would you like to inpect first?\n\n";
# Block 4. The main program loop
chop( my $question = <> ); #Get the question from the standard input
$question = lc $question;
# Main program loop
until ( $question eq 'thanks' ) {
question($question, $who, $what, $where, \@perp, \@weap, \@rm, \%weapon, \%room);
chop( $question = <> ); #Get another question from the standard input
$question = lc $question;
} #End main loop
############# Subroutines ###################
# Perl Cookbook (Christiansen & Torkington 1998, p. 121)
sub fisher_yates_shuffle {
my $array = shift;
my $i;
for ( $i = @$array; --$i; ) {
my $j = int rand ($i+1);
next if $i == $j;
@$array[$i,$j] = @$array[$j,$i];
} # end for array
} #end sub shuffle
#!/usr/local/bin/perl
# Question4.pm
# Responds to clue5.pl
package Question4;
use Exporter;
our @ISA = qw( Exporter );
our @EXPORT = qw( &question );
@mustard = ("A beastly night for this sort of thing, eh Chief Inspector?\n",
"Who would leave something like this lying about?\n");
@plum = ("Good to see you again old boy.\n",
"Are you making any progress old bean?\n");
@scarlet = ("I would tell you anything you want to know!\n",
"I might have something else for you up in my bedroom.\n");
@peacock = ("The sooner you can clear up this mess the better.\n",
"Haven't you solved this business yet?\n");
@white = ("I'm afraid to stay here a minute longer.\n",
"Can you leave a constable to protect me?\n");
@green = ("I haven't heard a thing all evening.\n",
"I'm afraid I can't help you any further.\n");
sub question {
my $n = $n + 1; #Count the number of steps
my $q = 0; #Flag to see if question is legitimate
my $question = $_[0];
my $who = $_[1];
my $what = $_[2];
my $where = $_[3];
my @perp = @{$_[4]};
my @weap = @{$_[5]};
my @rm = @{$_[6]};
my %weapon = %{$_[7]};
my %room = %{$_[8]};
# where is plum?
if ( $question =~ m/where is (\w+)/ ) {
print "$1 is in the $room{$1}.\n";
$q = $q + 1;
} # end if where
# go to the study
elsif ( $question =~ m/the (\w+)/ ) {
foreach $rm (@rm) {
if ( $1 eq $rm ) {
$computer = $1;
print "\nJeeves: This way Chief Inspector.\n";
print "\nJeeves: We are now in the $computer.\n";
$q = $q + 1;
if ( $computer eq $where ) {
print "\n\Jeeves: There\'s a body stretched out on the floor here!\n";
} # end if where
foreach $person (keys %room) {
if ( $room{$person} eq $computer ) {
print "\nJeeves: Chief Inspector, allow me to introduce you to $person.\n";
print "\n$person: Good evening Chief Inspector.";
print "\n$person: @$person[0]\n";
$ref = $person;
if ($person eq "peacock" or $person eq "scarlet" or $person eq "white" ) {
$pronoun = "her"; }
else {$pronoun = "him"; }
if ( my $time eq '' ) {
print "\nJeeves: You might ask $pronoun to assist you.\n\n";
$time = $time +1;
} #end if time
return;
} # end if room
} # end foreach person
print "\nJeeves: None of our guests are here Chief Inspector.\n";
print "Jeeves: Which room would you like to inspect next?\n\n";
} # end if_room
} # end foreach_room
} # end elsif go to
# can_you help me?
elsif ( $question =~ m/(what )?(can|will|did) you.*/ ) {
$q = $q + 1;
print "$ref: I found this $weapon{$ref} when I entered the $room{$ref}\n";
print "$ref: @$ref[1]\n";
if ( $what eq $weapon{$ref} ) {
print "$ref: The $what has blood stains on it.\n";
print "\nJeeves: You might ask who gave the $what to $pronoun.\n\n";
return;
} # end if what
print "\nJeeves: Which room would you like to inspect now?\n\n";
} # end if can you
# who_gave_it
elsif ( $question =~ m/who gave you the (\w+)/ ) {
$q = $q + 1;
if ( $1 ne $what ) {
print "$ref: It was here all along.\n\n";
} # end if ne what
elsif ( $ref ne $who ) {
print "$ref: $who gave it to me.\n\n";
} # end ne who
else {print "$ref: I found it in the $where.\n\n";}
} #end who gave it
# what_rooms are there?
elsif ( $question =~ m/what rooms/ ) {
print "The mansion contains nine rooms.\n";
print "We are presently standing in the $computer.\n";
print "There are the study, the library, the billiard_room and the lounge.\n";
print "There are also the ballroom, the conservatory, the dining_room and the kitchen.\n";
$q = $q + 1;
} # end what rooms
# what does plum have?
elsif ( $question =~ m/what does (\w+) have/) {
print "Jeeves: $1 has the $weapon{$1}.\n";
$q = $q + 1;
if ( $what eq $weapon{$1} ) {
print "The $what has blood stains on it.\n";
} # end if what weapon
} #end what does x have
# inspect the body
elsif ( $question =~ m/((look at)|inspect) the body/) {
$q = $q + 1;
if ( $computer eq $where ) {
if ( $what eq 'knife' ) {
print "There are stab wounds on the body.\n\n";
} # end if knife
if ( $what eq 'candlestick' ) {
print "The victim was beaten with a blunt instrument.\n\n";
} # end if candlestick
if ( $what eq 'lead_pipe' ) {
print "The victim was beaten with a blunt instrument.\n\n";
} # end if lead pipe
if ( $what eq 'wrench' ) {
print "The victim was beaten with a blunt instrument.\n\n";
} # end if wrench
if ( $what eq 'revolver' ) {
print "There are bullet wounds in the body.\n\n";
} # end if revolver
if ( $what eq 'rope' ) {
print "There are rope burns around the neck.\n\n";
} # end if rope
} #end if where
else { print "What body?\n"; }
} #end inspect
# was it plum in the study with the wrench?
elsif ( $question =~ m/was it (\w+) in the (\w+) with (a|the) (\w+)/ ) {
$q = $q + 1;
if ($1 eq $who and $2 eq $where and $4 eq $what) {
print "Jeeves: Congratulations! You found the perpetrator!\n";
print "Jeeves: It only took you $n turns to catch the culprit.\n";
exit;
} # end congrats
elsif ($1 eq $who and $4 eq $what) {
print "Jeeves: Now you need to find the right room.\n\n";
} # end hint who and what
elsif ($2 eq $where and $4 eq $what) {
print "Jeeves: Now you need to find the culprit.\n\n";
} # end hint where and what
elsif ($1 eq $who) {
print "Jeeves: You\'re on the right track! \n\n";
} # end hint who
elsif ($4 eq $what) {
print "Jeeves: You\'ve discovered the weapon!\n\n";
} # end hint what
else {print "Jeeves: You still need to eliminate some suspects.\n\n";}
} # end guess
if ( $q == 0 ) {
print "I don\'t understand. Please rephrase that.\n";
} # end if $q
} # end sub question
return 1;
#!/usr/local/bin/perl
#prob75.pl
#Raechel's solution
print "Content-type: text/html\n\n";
$i = 1;
while ($i <= 10) {
$ia = $i**2;
print "<html><title>Ex 75</title>";
print "<body>";
print "<p>$ia equals $i squared</p>";
print "</body></html>";
$i++;
}
#!/usr/local/bin/perl
#prob76.pl
use CGI qw( :standard );
print header(), start_html ( "Ex 7.6" );
print '<table border = "1" cellspacing = "2">';
$i = 1;
while ($i <= 10) {
$ia = $i**2;
print Tr( td( "$i squared equals" ),
td( $ia ) );
$i++;
}
print '</table>', end_html();