# Most of these examples originated for lectures notes given by Professor
# Dennis Shasha
# sh this file to unpack perl examples
echo db.pl
cat >db.pl <<'END of db.pl'
#!/usr/local/bin/perl
#Other systems would use #!/usr/bin/perl
#dbaccess
dbmopen(NAMEDB,"mydb",0644) 
|| die "No mydb!";

$NAMEDB{"Danielle"} = "prof who is demonstrating Perl examples";
$NAMEDB{"Peter"} = "TA having a toothache";
$NAMEDB{"Paul"} = "Grader debating about law school";
$NAMEDB{"Ronny"} = "Student having too little homework";
print "Paul's value is $NAMEDB{\"Paul\"}\n";
$NAMEDB{"Sophie"} = "Student having too little homework";
$NAMEDB{"Tsui-ying"} = "Student having too much homework";
$NAMEDB{"Jean "} = "Student having too much fun ";
$NAMEDB{"Jose"} = "Student having about the right amount of fun ";
$NAMEDB{"Alice,ferrari"} = 34;
END of db.pl
echo db2.pl
cat >db2.pl <<'END of db2.pl'
#!/usr/local/bin/perl
#Other systems would use #!/usr/bin/perl
#dbaccess
dbmopen(NAMEDB,"mydb",0644) 
|| die "No mydb!";
print "Please tell me whom you would like to know about:\n ";
chop($input = <STDIN>);
print "Here is what I know: $NAMEDB{$input}\n ";
END of db2.pl
echo dblog
cat >dblog <<'END of dblog'
00: 96/10/28 13:44:31.66 kernel: 252.227-7013(c)(1)(ii) for Department of Defense contracts.
00: 96/10/28 13:44:31.66 kernel: Sybase reserves all unpublished rights under the copyright
00: 96/10/28 13:44:31.66 kernel: laws of the United States.
00: 96/10/28 13:44:31.66 kernel: Sybase, Inc. 6475 Christie Avenue, Emeryville, CA 94608, USA.
00: 96/10/28 13:44:31.66 kernel: Logging SQL Server messages in file '/opt/sybase/install/errorlog'.
00: 96/10/28 13:44:31.66 kernel: Using config area of disk for boot information
00: 96/10/28 13:44:31.66 kernel: Using config area from primary master device.
00: 96/10/28 13:44:31.72 kernel: Using 300 file descriptors.
00: 96/10/28 13:44:31.72 kernel: Network and device connection limit is 294.
00: 96/10/28 13:44:31.72 kernel: Dump/Load buffers configured with 8 pages.
00: 96/10/28 13:44:31.75 kernel: Initializing virtual device 0, "/tmp/master.dat"
00: 96/10/28 13:44:31.75 kernel: Virtual device 0 started using standard unix i/o.
00: 96/10/28 13:44:31.75 kernel: ninit:1: listener type: console
00: 96/10/28 13:44:31.75 kernel: ninit:1: listener endpoint: /dev/tcp
00: 96/10/28 13:44:31.75 kernel: ninit:1: listener raw address: \x000211d8a1ef99ef0000000000000000
00: 96/10/28 13:44:31.75 kernel: ninit:1: transport provider: T_COTS_ORD
00: 96/10/28 13:44:31.76 server: Number of buffers in buffer cache: 1185.
00: 96/10/28 13:44:31.76 server: Number of proc buffers allocated: 296.
00: 96/10/28 13:44:31.76 server: Number of blocks left for proc headers: 283.
00: 96/10/28 13:44:31.78 server: Opening Master Database ...
00: 96/10/28 13:44:31.85 server: Loading SQL Server's default sort order and character set
00: 96/10/28 13:44:31.86 kernel: ninit:0: listener type: master
00: 96/10/28 13:44:31.86 kernel: ninit:0: listener endpoint: /dev/tcp
00: 96/10/28 13:44:31.86 kernel: ninit:0: listener raw address: \x000211d7a1ef99ef0000000000000000
00: 96/10/28 13:44:31.86 kernel: ninit:0: transport provider: T_COTS_ORD
00: 96/10/28 13:44:31.87 server: Recovering database 'master'
00: 96/10/28 13:44:31.89 server: Recovery dbid 1 ckpt (1871,18) oldest tran=(1871 ,17)
00: 96/10/28 13:44:31.91 server: 13 transactions rolled forward.
00: 96/10/28 13:44:31.91 server: 2 transactions rolled back.
00: 96/10/28 13:44:31.95 server: server is unnamed
00: 96/10/28 13:44:31.96 server: Activating disk 'data_2'.
00: 96/10/28 13:44:31.96 kernel: Initializing virtual device 3, "/tmp/data2"
00: 96/10/28 13:44:31.96 kernel: Virtual device 3 started using standard unix i/o.
00: 96/10/28 13:44:31.96 server: Activating disk 'data_arch_1'.
00: 96/10/28 13:44:31.96 kernel: Initializing virtual device 5, "/dev/dsk/c2t2d0s1"
00: 96/10/28 13:44:31.96 kernel: Virtual device 5 started using standard unix i/o.
00: 96/10/28 13:44:31.96 server: Activating disk 'data_arch_2'.
00: 96/10/28 13:44:31.96 kernel: Initializing virtual device 6, "/dev/dsk/c2t2d0s3"
00: 96/10/28 13:44:31.97 kernel: Virtual device 6 started using standard unix i/o.
00: 96/10/28 13:44:31.98 server: Recovering database 'model'.
00: 96/10/28 13:44:31.98 server: Recovery dbid 3 ckpt (260,26)
00: 96/10/28 13:44:31.98 server: Recovery no active transactions before ckpt.
00: 96/10/28 13:44:31.98 server: Clearing temp db 
00: 96/10/28 13:44:32.04 server: Recovery complete.
00: 96/10/28 13:44:32.04 server: SQL Server's default sort order is:
00: 96/10/28 13:44:32.04 server: 	'bin_iso_1' (ID = 50)
00: 96/10/28 13:44:32.04 server: on top of default character set:
00: 96/10/28 13:44:32.04 server: 	'iso_1' (ID = 1).
00: 96/10/28 14:31:23.24 server: Recovery dbid 4 ckpt (998666,10)
00: 96/10/28 14:31:23.27 server: Recovery no active transactions before ckpt.
00: 96/10/28 15:01:24.92 kernel: Initializing virtual device 9, "/tmp/temp2.dat"
00: 96/10/28 15:01:24.94 kernel: Virtual device 9 started using standard unix i/o.
00: 96/10/28 15:02:29.13 server: SQL Server shutdown by request.
00: 96/10/28 15:02:29.14 kernel: ueshutdown: exiting
00: 96/10/28 13:44:31.66 kernel: 252.227-7013(c)(1)(ii) for Department of Defense contracts.
00: 96/10/28 13:44:31.66 kernel: Sybase reserves all unpublished rights under the copyright
00: 96/10/28 13:44:31.66 kernel: laws of the United States.
00: 96/10/28 13:44:31.66 kernel: Sybase, Inc. 6475 Christie Avenue, Emeryville, CA 94608, USA.
00: 96/10/28 13:44:31.66 kernel: Logging SQL Server messages in file '/opt/sybase/install/errorlog'.
00: 96/10/28 13:44:31.66 kernel: Using config area of disk for boot information
00: 96/10/28 13:44:31.66 kernel: Using config area from primary master device.
00: 96/10/28 13:44:31.72 kernel: Using 300 file descriptors.
00: 96/10/28 13:44:31.72 kernel: Network and device connection limit is 294.
00: 96/10/28 13:44:31.72 kernel: Dump/Load buffers configured with 8 pages.
00: 96/10/28 13:44:31.75 kernel: Initializing virtual device 0, "/tmp/master.dat"
00: 96/10/28 13:44:31.75 kernel: Virtual device 0 started using standard unix i/o.
00: 96/10/28 13:44:31.75 kernel: ninit:1: listener type: console
00: 96/10/28 13:44:31.75 kernel: ninit:1: listener endpoint: /dev/tcp
00: 96/10/28 13:44:31.75 kernel: ninit:1: listener raw address: \x000211d8a1ef99ef0000000000000000
00: 96/10/28 13:44:31.75 kernel: ninit:1: transport provider: T_COTS_ORD
00: 96/10/28 13:44:31.76 server: Number of buffers in buffer cache: 1185.
00: 96/10/28 13:44:31.76 server: Number of proc buffers allocated: 296.
00: 96/10/28 13:44:31.76 server: Number of blocks left for proc headers: 283.
00: 96/10/28 13:44:31.78 server: Opening Master Database ...
00: 96/10/28 13:44:31.85 server: Loading SQL Server's default sort order and character set
00: 96/10/28 13:44:31.86 kernel: ninit:0: listener type: master
00: 96/10/28 13:44:31.86 kernel: ninit:0: listener endpoint: /dev/tcp
00: 96/10/28 13:44:31.86 kernel: ninit:0: listener raw address: \x000211d7a1ef99ef0000000000000000
00: 96/10/28 13:44:31.86 kernel: ninit:0: transport provider: T_COTS_ORD
00: 96/10/28 13:44:31.87 server: Recovering database 'master'
00: 96/10/28 13:44:31.89 server: Recovery dbid 1 ckpt (1871,18) oldest tran=(1871 ,17)
00: 96/10/28 13:44:31.91 server: 13 transactions rolled forward.
00: 96/10/28 13:44:31.91 server: 2 transactions rolled back.
00: 96/10/28 13:44:31.95 server: server is unnamed
00: 96/10/28 13:44:31.96 server: Activating disk 'data_2'.
00: 96/10/28 13:44:31.96 kernel: Initializing virtual device 3, "/tmp/data2"
00: 96/10/28 13:44:31.96 kernel: Virtual device 3 started using standard unix i/o.
00: 96/10/28 13:44:31.96 server: Activating disk 'data_arch_1'.
00: 96/10/28 13:44:31.96 kernel: Initializing virtual device 5, "/dev/dsk/c2t2d0s1"
00: 96/10/28 13:44:31.96 kernel: Virtual device 5 started using standard unix i/o.
00: 96/10/28 13:44:31.96 server: Activating disk 'data_arch_2'.
00: 96/10/28 13:44:31.96 kernel: Initializing virtual device 6, "/dev/dsk/c2t2d0s3"
00: 96/10/28 13:44:31.97 kernel: Virtual device 6 started using standard unix i/o.
00: 96/10/28 13:44:31.98 server: Recovering database 'model'.
00: 96/10/28 13:44:31.98 server: Recovery dbid 3 ckpt (260,26)
00: 96/10/28 13:44:31.98 server: Recovery no active transactions before ckpt.
00: 96/10/28 13:44:31.98 server: Clearing temp db 
00: 96/10/28 13:44:32.04 server: Recovery complete.
00: 96/10/28 13:44:32.04 server: SQL Server's default sort order is:
00: 96/10/28 13:44:32.04 server: 	'bin_iso_1' (ID = 50)
00: 96/10/28 13:44:32.04 server: on top of default character set:
00: 96/10/28 13:44:32.04 server: 	'iso_1' (ID = 1).
00: 96/10/28 14:31:23.24 server: Recovery dbid 4 ckpt (998666,10)
00: 96/10/28 14:31:23.27 server: Recovery no active transactions before ckpt.
00: 96/10/28 15:01:24.92 kernel: Initializing virtual device 9, "/tmp/temp2.dat"
00: 96/10/28 15:01:24.94 kernel: Virtual device 9 started using standard unix i/o.
00: 96/10/28 15:02:29.13 server: SQL Server shutdown by request.
00: 96/10/28 15:02:29.14 kernel: ueshutdown: exiting
END of dblog
echo device.pl
cat >device.pl <<'END of device.pl'
#!/usr/local/bin/perl
@x = <>;
@y = reverse @x;
$i = -1;
$flag = 1;
# produces a list of lines from last startup and puts it in @w.
foreach $line (@y)
{
	if ($line =~ /Emeryville/) {$flag = 0;}
	if (($flag == 1))  {
		$i = $i + 1;
		$z[$i] = $line;
	}
}
@w = reverse @z;

# get the lines that match what we are interested in and put them in @w1
$i = -1;
foreach $line (@w)
{
	if (($line =~ /Activating disk/) ||
	  ($line =~ /Initializing virtual device /) ||
	  ($line =~ /mirror: /))  {
		$i = $i + 1;
		$w1[$i] = $line;
	}
};
# creates two associative arrays physicalDevice and logicalDevice
# that are maps from virtual device numbers to physical and logical devices respectively.
# Example: 
# 00: 96/10/28 13:44:31.96 server: Activating disk 'data_2'.
# 00: 96/10/28 13:44:31.96 kernel: Initializing virtual device 3, "/tmp/data2"
# produces physicalDevice{3} = /tmp/data2 and logicalDevice{3} = data_2

$lastLogicalDevice = "newDevice";
foreach $line (@w1)
{
	# record the lastLogicalDevice
	if ($line =~ /Activating disk/){ 
		@arr = split(/[ 	]+/, $line);
   		if ($arr[4] =~ /Activating/) {
                        @little3 = split(/["']/, $arr[6]);
                } else {
			chop($arr[5]);
                        @little3 = split(/["']/, $arr[5]);
                }
		$lastLogicalDevice = $little3[1];
	}
	# lastLogicalDevice will come from the Activating disk line.
	# ASSUMPTION: Activating disk will come before Initializing virtual device...
	if ($line =~ /Initializing virtual device/){ 
		@arr = split(/[ 	]+/, $line);
   		if ($arr[4] =~ /Initializing/) {
			@little2 = split(/,/, $arr[7]);
			@little = split(/["']/, $arr[8]);
		} else {
			@little2 = split(/,/, $arr[6]);
			@little = split(/["']/, $arr[7]);
		}
		$virtdevice = $little2[0];
		if ($virtdevice == 0) { $lastLogicalDevice = "master";}
		$logicalDevice{$virtdevice} = $lastLogicalDevice;
		$physicalDevice{$virtdevice} = $little[1];
		print "device number is $virtdevice, logical device is $logicalDevice{$virtdevice}\n";
		print "and physical device is $physicalDevice{$virtdevice}\n";
		$lastLogicalDevice = "newDevice";
	}
}
	  
END of device.pl
echo ex1.pl
cat >ex1.pl <<'END of ex1.pl'
#!/usr/local/bin/perl
# adds line numbers to a program
#Results to standard out.

$linenum = 1;
while (<>) {
   print "$linenum :: $_";
   $linenum++;
}
   
END of ex1.pl
echo ex2.pl
cat >ex2.pl <<'END of ex2.pl'
#!/usr/local/bin/perl
#Other systems would use #!/usr/bin/perl
#ex_03-2
#Learning Perl Appendix A, Exercise 3.2
#This illustrates the use of arrays.
# The chop procedure eliminates the newline returned
# by the call to STDIN.
print "Enter the line number: "; 
chomp($a = <STDIN>);
print "Enter the lines, end with ^D:\n "; @b = <STDIN>;
print "Answer: $b[$a-1]";

END of ex2.pl
echo ex3.pl
cat >ex3.pl <<'END of ex3.pl'
#!/usr/local/bin/perl
#Other systems would use #!/usr/bin/perl
#ex_05-1a
#Learning Perl Appendix A, Exercise 5.1
#This illustrates the use of associative arrays (like maps).
%foo = ('redfruit','apple tomato strawberry','red', 'face', 'green','leaves','blue','ocean');
print "A string please: "; chop($some_string = <STDIN>);
print "The value for $some_string is $foo{$some_string}\n ";

END of ex3.pl
echo ex5.pl
cat >ex5.pl <<'END of ex5.pl'
#!/usr/local/bin/perl
#Other systems would use #!/usr/bin/perl
#ex_05-2
#Learning Perl Appendix A, Exercise 5.2
#This illustrates the use of foreach and how one refers to arrays
#(with @) and to associative arrays (with %).
print "please type a list of words and end with control D\n";
@words = <STDIN>; # read the words
foreach $line (@words) {
		chop($line); # remove that pesky newline
		$count{$line} = $count{$line} + 1; # or $count{$line}++
}
foreach $line (keys %count) {
		print "$line was seen $count{$line} times\n ";
}

END of ex5.pl
echo foreach.pl
cat >foreach.pl <<'END of foreach.pl'
#!/usr/local/bin/perl

@a=(3, 5, 7, 9);
foreach $b (reverse @a) {
	print " $b \n";
}
END of foreach.pl
echo foreach2.pl
cat >foreach2.pl <<'END of foreach2.pl'
#!/usr/local/bin/perl

@a=(3, 5, 7, 9);
foreach $one (@a) {
	$one *= 3;
}
print"  @a \n";

END of foreach2.pl
echo grades
cat >grades <<'END of grades'
Noel 25
Ben 76
Clementine 49
Norm 66
Chris 92
Doug 42
Carol 25
Ben 12
Clementine 0
Norm 66
Noel 88
Chris 	87
Doug	78
Carol   56
END of grades
echo grades.pl
cat >grades.pl <<'END of grades.pl'
#!/usr/local/bin/perl

open(GRADES, "grades") or die "Can't open grades: $!\n";
while  ($line = <GRADES>) {
	($student, $grade) = split(" ", $line);
	$grades{$student} .=$grade . " ";
}

foreach $student (sort keys %grades) {
	$scores = 0;
	$total = 0;
	@grades = split(" ", $grades{$student});
	foreach $grade (@grades) {
		$total += $grade;
		$scores++;
	}
	$average = $total/ $scores;
	print "$student: $grades{$student}\tAverage: $average\n";
}
END of grades.pl
echo join.pl
cat >join.pl <<'END of join.pl'
#!/usr/local/bin/perl

$line = "merlyn::118:120:Randall:/home/merlyn:/usr/bin/perl";
@fields = split(/:/, $line);

$outline = join(":", @fields);
print "$outline \n";
END of join.pl
echo morse.pl
cat >morse.pl <<'END of morse.pl'
#!/usr/local/bin/perl
#Use maps so that given a letter, you can produce a code word.

%foo= (
'a', '._', 'b', '_...',
'c', '_._.',
'd', '_..',
'e', '.',
'f', '.._.',
'g', '__.',
'h', '....',
'i', '..',
'j', '.___',
'k', '_._',
'l', '._..',
'm', '__',
'n', '_.',
'o', '___',
'p', '.__.',
'q', '__._',
'r', '._.',
's', '...',
't', '_',
'u', '.._',
'v', '..._',
'w', '.__',
'x', '_.._',
'y', '_.__',
'z', '__..',
1, '.____',
2, '..___',
3, '...__',
4, '...._',
5, '.....',
6, '_....',
7, '__...',
8, '___..',
9, '____.',
0, '_____'
);
print "A letter or number please: "; chop($some_string = <STDIN>);
print "The code for $some_string is $foo{$some_string}\n ";
END of morse.pl
echo morse2.pl
cat >morse2.pl <<'END of morse2.pl'
#!/usr/local/bin/perl
#Use maps so that given a letter, you can produce a code word.

%foo= (
'a', '._', 'b', '_...',
'c', '_._.',
'd', '_..',
'e', '.',
'f', '.._.',
'g', '__.',
'h', '....',
'i', '..',
'j', '.___',
'k', '_._',
'l', '._..',
'm', '__',
'n', '_.',
'o', '___',
'p', '.__.',
'q', '__._',
'r', '._.',
's', '...',
't', '_',
'u', '.._',
'v', '..._',
'w', '.__',
'x', '_.._',
'y', '_.__',
'z', '__..',
1, '.____',
2, '..___',
3, '...__',
4, '...._',
5, '.....',
6, '_....',
7, '__...',
8, '___..',
9, '____.',
0, '_____'
);
print "A string of letters or numbers please: ";
chop($some_string = <STDIN>);
@letters = split(//,$some_string); #gets letter by letter
print "   ";
foreach $let (@letters) {
 print "$foo{$let} ";
}
print "\n\n ";
END of morse2.pl
echo morse4.pl
cat >morse4.pl <<'END of morse4.pl'
#!/usr/local/bin/perl
#Use maps so that given a letter, you can produce a code word.

%foo= (
'a', '._', 'b', '_...',
'c', '_._.',
'd', '_..',
'e', '.',
'f', '.._.',
'g', '__.',
'h', '....',
'i', '..',
'j', '.___',
'k', '_._',
'l', '._..',
'm', '__',
'n', '_.',
'o', '___',
'p', '.__.',
'q', '__._',
'r', '._.',
's', '...',
't', '_',
'u', '.._',
'v', '..._',
'w', '.__',
'x', '_.._',
'y', '_.__',
'z', '__..',
1, '.____',
2, '..___',
3, '...__',
4, '...._',
5, '.....',
6, '_....',
7, '__...',
8, '___..',
9, '____.',
0, '_____'
);
while (<>) {
chop($some_string = $_);
@letters = split(//,$some_string); #gets letter by letter
print "   ";
foreach $let (@letters) {
 print "$foo{$let} ";
}
print "\n\n ";
}
END of morse4.pl
echo morse5.pl
cat >morse5.pl <<'END of morse5.pl'
#!/usr/local/bin/perl
#Use maps so that given a letter, you can produce a code word.

%foo= (
'a', '._', 'b', '_...',
'c', '_._.',
'd', '_..',
'e', '.',
'f', '.._.',
'g', '__.',
'h', '....',
'i', '..',
'j', '.___',
'k', '_._',
'l', '._..',
'm', '__',
'n', '_.',
'o', '___',
'p', '.__.',
'q', '__._',
'r', '._.',
's', '...',
't', '_',
'u', '.._',
'v', '..._',
'w', '.__',
'x', '_.._',
'y', '_.__',
'z', '__..',
1, '.____',
2, '..___',
3, '...__',
4, '...._',
5, '.....',
6, '_....',
7, '__...',
8, '___..',
9, '____.',
0, '_____'
);

while (($let, $code) = each(%foo)) {
   $fooinverse{$code} = $let;
}

#print "Please enter several lines of code words.\n ";

while  (<STDIN>) {
   $x = $_;
   chop($x);
   @codelets = split(/ /,$x); #get separate letters
   #print "Here is the code: $x\n ";
   foreach $codelet (@codelets) {
      #print "Here is the codelet: $codelet";
      print "$fooinverse{$codelet}";
   }
   print "\n ";
}
END of morse5.pl
echo morsespy
cat >morsespy <<'END of morsespy'
president's embargo ruling should have immediate notice. 
grave situation affecting international law. 
statement foreshadows ruin of many neutrals. 
yellow journals unifying national excitement immensely.
END of morsespy
echo mydb.dir
cat >mydb.dir <<'END of mydb.dir'
END of mydb.dir
echo newsub.pl
cat >newsub.pl <<'END of newsub.pl'
#!/usr/local/bin/perl

$value = "original";

tellme();
spoof();
tellme();

sub spoof {
	local($value) = "temporary";
	tellme();
}

sub tellme {
	print "current value is $value\n"
}
END of newsub.pl
echo README
cat >README <<'END of README'
Most of these examples are taken from lectures notes given by Professor
Dennis Shasha. 
Other examples were retrieved from the books Learning Perl and Programming
Perl by Randy Schwartz, O'Reilly Press.

usage for some examples:
morse4.pl morsepsy
morse5.pl <out

END of README
echo split.pl
cat >split.pl <<'END of split.pl'
#!/usr/local/bin/perl

$line = "merlyn::118:120:Randall:/home/merlyn:/usr/bin/perl";
@fields = split(/:/, $line);
print @fields;

END of split.pl
echo sub.pl
cat >sub.pl <<'END of sub.pl'
#!/usr/local/bin/perl
#Other systems would use #!/usr/bin/perl
#ex_hello
@password = getpwuid($<); # get the password data
print "What is this \$<? $<\n";
$name = $password[6]; # get just the GCOS field
print "name before filtering: $name\n";
$name =~ s/,.*//; # throw away everything after first comma
print "Hello, $name! glad to hear from you\n "; 
print "What is the secret word? ";
$guess = <STDIN>;
chop($guess);
@arr = split(/ /, $name);

while (! good_word($arr[0],$guess)) {
	print "Wrong, try again. What is the secret word? ";
	$guess = <STDIN>;
	chop($guess);
}
print "Very Good, $arr[0].\n Perl on.\n";
sub good_word {
		local($somename,$someguess) = @_; # name the parameters
		if($somename =~ reverse($someguess)) {
			1;
		} else {0;}
}

END of sub.pl
echo subroutine.pl
cat >subroutine.pl <<'END of subroutine.pl'
#!/usr/local/bin/perl
#Other systems would use #!/usr/bin/perl
#ex_hello
@password = getpwuid($<); # get the password data
print "What is this \$<? $<\n";
$name = $password[6]; # get just the GCOS field
print "name before filtering: $name\n";
$name =~ s/,.*//; # throw away everything after first comma
print "Hello, $name! glad to hear from you\n "; 
print "What is the secret word? ";
$guess = <STDIN>;
chop($guess);
@arr = split(/ /, $name);
while (! &good_word($arr[0],$guess)) {
	print "Wrong, try again. What is the secret word? ";
	$guess = <STDIN>;
	chop($guess);
}
print "Very Good, $arr[0].\n Perl on.\n";
sub good_word {
		local($somename,$someguess) = @_; # name the parameters
		if($somename =~ reverse($someguess)) {
			1;
		} else {0;}
}

END of subroutine.pl