- Here is one possible solution:
sub add_two {
local ($arg1, $arg2) = @_;
$result = $arg1 + $arg2;
}
- Here is one possible solution:
sub count_t {
local ($string) = @_;
# There are a couple of tricks you can use to do this.
# This one splits the string into words using "t" as
# the split pattern. The number of occurrences of "t"
# is one less than the number of words resulting from
# the split.
@dummy = split(/t/, $string);
$retval = @dummy - 1;
}
- Here is one possible solution:
sub diff {
local ($file1, $file2) = @_;
# return false if we can't open a file
return (0) unless open (FILE1, "$file1");
return (0) unless open (FILE2, "$file2");
while (1) {
$line1 = <FILE1>;
$line2 = <FILE2>;
if ($line1 eq "") {
$retval = ($line2 eq "");
last;
}
if ($line2 eq "" || $line1 ne $line2) {
$retval = 0;
last;
}
}
# you should use close here, as this subroutine may
# be called many times
close (FILE1);
close (FILE2);
# ensure that the return value is the last evaluated
# expression
$retval;
}
- Here is one possible solution:
sub dieroll {
$retval = int (rand(6)) + 1;
}
- Here is one possible solution:
# assume that the first call to printlist passes the argument
# 0 as the value for $index
sub printlist {
local ($index, @list) = @_;
if ($index + 1 < @list) {
&printlist ($index+1, @list);
}
# the conditional handles the case of an empty list
print ("$list[$index]\n") if (@list > 0);
}
- The subroutine print_ten overwrites the value stored
in the global variable $count. To fix this problem, define
$count as a local variable. (You also should define $printval
as a local variable, in case someone adds this variable to the
main program at a later time.)
- The local statement in the subroutine assigns both
the list and the search word to @searchlist, which means
that $searchword is assigned the empty string. To fix
this problem, switch the order of the arguments, putting the search
word first.
- If split produces a nonempty list, the last expression
evaluated in the subroutine is the conditional expression, which
has the value 0 (false):
@words == 0
Therefore, the return value of this subroutine is 0,
not the list of words.
To get around this problem, put the following statement after
the if statement:
@words;
This ensures that the list of words is always the return
value.
- Here is one possible solution:
#!/usr/local/bin/perl
while ($line = <STDIN>) {
$line =~ s/^\s+|\s+$//g;
($subscript, $value) = split(/\s+/, $line);
$array{$subscript} = $value;
}
- Here is one possible solution:
#!/usr/local/bin/perl
$linenum = 0;
while ($line = <STDIN>) {
$linenum += 1;
$line =~ s/^\s+|\s+$//g;
@words = split(/\s+/, $line);
if ($words[0] eq "index" &&
$index{$words[1]} eq "") {
$index{$words[1]} = $linenum;
}
}
foreach $item (sort keys (%index)) {
print ("$item: $index{$item}\n");
}
- Here is one possible solution:
#!/usr/local/bin/perl
$linenum = 0;
while ($line = <STDIN>) {
$linenum += 1;
$line =~ s/^\s+|\s+$//g;
@words = split(/\s+/, $line);
# This program uses a trick: for each word, the array
# item $index{"word"} stores the number of occurrences
# of that word. Each occurrence is stored in the
# element $index{"word#n"}, where[]is a
# positive integer.
if ($words[0] eq "index") {
if ($index{$words[1]} eq "") {
$index{$words[1]} = 1;
$occurrence = 1;
} else {
$index{$words[1]} += 1;
$occurrence = $index{$words[1]};
}
$index{$words[1]."#".$occurrence} = $linenum;
}
}
# The loop that prints the index takes advantage of the fact
# that, when the list is sorted, the elements that count
# occurrences are always processed just before the
# corresponding elements that store occurrences. For example:
# $index{word}
# $index{word#1}
# $index{word#2}
foreach $item (sort keys (%index)) {
if ($item =~ /#/) {
print ("\n$item:");
} else {
print (" $index{$item}");
}
}
print ("\n");
- Here is one possible solution:
#!/usr/local/bin/perl
$student = 0;
@subjects = ("English", "history", "mathematics",
"science", "geography");
while ($line = <STDIN>) {
$line =~ s/^\s+|\s+$//g;
@words = split (/\s+/, $line);
@students[$student++] = $words[0];
for ($count = 1; $count <= 5; $count++) {
$marks{$words[0].$subjects[$count-1]} =
$words[$count];
}
}
# now print the failing grades, one student per line
foreach $student (sort (@students)) {
$has_failed = 0;
foreach $subject (sort (@subjects)) {
if ($marks{$student.$subject} < 50) {
if ($has_failed == 0) {
$has_failed = 1;
print ("$student failed:");
}
print (" $subject");
}
}
if ($has_failed == 1) {
print ("\n");
}
}
- This program has one problem and one unwanted feature.
The problem: Adding a new element to %list in the middle
of a foreach loop that uses the function keys
yields unpredictable results.
The unwanted feature: The foreach loop doubles the size
of the associative array because the original elements Fred,
John, Jack, and Mary are not deleted.
- Here is one possible solution:
#!/usr/local/bin/perl
opendir (MYDIR, "/u/jqpublic") ||
die ("Can't open directory");
while ($file = readdir (MYDIR)) {
next if ($file =~ /^\.{1,2}$|^[^.]/);
print ("$file\n");
}
closedir (MYDIR);
- Here is one possible solution:
#!/usr/local/bin/perl
$filecount = 1;
&print_dir ("/u/jqpublic");
sub print_dir {
local ($dirname) = @_;
local ($file, $subdir, $filevar);
$filevar = "MYFILE" . $filecount++;
opendir ($filevar, $dirname) ||
die ("Can't open directory");
# first pass: read and print file names
print ("\ndirectory $dirname:\n");
while ($file = readdir ($filevar)) {
next if ($file eq "." || $file eq "..");
next if (-d ($dirname . "/" . $file));
print ("$file\n");
}
# second pass: recursively print subdirectories
rewinddir ($filevar);
while ($subdir = readdir ($filevar)) {
next unless (-d ($dirname . "/" . $subdir));
next if ($subdir eq "." || $subdir eq "..");
&print_dir ($dirname . "/" . $subdir);
}
closedir ($filevar);
}
- Here is one possible solution:
#!/usr/local/bin/perl
opendir (MYDIR, "/u/jqpublic") ||
die ("Can't open directory");
# the following is a trick: "." is alphabetically less than
# anything we want to print, so it makes a handy
# initial value
$lastfile = ".";
until (1) {
rewinddir (MYDIR);
$currfile = "";
while ($file = readdir (MYDIR)) {
next if ($file =~ /^\./);
if ($file gt $lastfile &&
($currfile eq "" || $file lt $currfile)) {
$currfile = $file;
}
}
last if ($currfile eq "");
print ("$currfile\n");
$lastfile = $currfile;
}
closedir (MYDIR);
- Here is one possible solution:
#!/usr/local/bin/perl
@digits = ("zero", "one", "two", "three",
"four", "five", "six", "seven",
"eight", "nine");
&start_hot_keys;
while (1) {
$char = getc(STDIN);
last if ($char eq "\033");
next if ($char =~ /[^0-9]/);
print ("$digits[$char]\n");
}
&end_hot_keys;
sub start_hot_keys {
system ("stty cbreak");
system ("stty -echo");
}
sub end_hot_keys {
system ("stty -cbreak");
system ("stty echo");
}
- Here is one possible solution:
#!/usr/local/bin/perl
$dir = "/u/dave/newperl/testdir";
opendir (MYDIR, $dir) ||
die ("Can't open directory");
chdir ($dir);
while ($file = readdir (MYDIR)) {
next if (-d $file);
next if ($file eq "." || $file eq "..");
if ($file =~ /\.pl$/) {
@stat = stat($file);
chmod (($stat[2] | 0700), $file);
} else {
chmod (0400, $file);
}
}
closedir (MYFILE);
- This program is trying to use eof() to test for the
end of a particular input file. In Perl, eof() tests
for the end of the entire set of input files, and eof
(with no parentheses) tests for the end of a particular input
file.
- Here is one possible solution:
#!/usr/local/bin/perl
$child = fork();
if ($child == 0) {
print ("This line goes first\n");
exit (0);
} else {
$child2 = fork();
if ($child2 == 0) {
waitpid ($child, 0);
print ("This line goes second\n");
exit (0);
} else {
waitpid ($child2, 0);
print ("This line goes third\n");
}
}
- Here is a program that reads from temp:
#!/usr/local/bin/perl
open (INFILE, "temp") || die
("Can't open input");
while ($line = <INFILE>) {
print ($line);
}
close (INFILE);
Here is a program that writes to temp and
calls the first program (which is assumed to be named ch13.2a):
#!/usr/local/bin/perl
open (OUTFILE, ">temp") || die ("Can't open output");
while ($line = <STDIN>) {
print OUTFILE ($line);
}
close (OUTFILE);
exec ("ch13.2a");
- Here is one possible solution:
#!/usr/local/bin/perl
for ($val = 1; $val <= 100; $val++) {
print ("log of $val is ", log($val), "\n");
}
- Here is one possible solution:
#!/usr/local/bin/perl
for ($i = 1; $i <= 6; $i++) {
&sum(10 ** $i);
}
sub sum {
local($limit) = @_;
local(@startval, @stopval);
local($i, $count);
$count = 0;
@startval = times();
for ($i = 1; $i <= $limit; $i++) {
$count += $i;
}
@stopval = times();
print ("sum $limit: ", $stopval[0]-$startval[0], "\n");
}
- Here is one possible solution:
#!/usr/local/bin/perl
$degrees = <STDIN>;
chop ($degrees);
$radians = $degrees * atan2(1,1) / 45;
$sin = sin ($radians);
$cos = cos ($radians);
print ("sin of $degrees is ", $sin, "\n");
print ("cos of $degrees is ", $cos, "\n");
print ("tan of $degrees is ", $sin/$cos, "\n");
- The output specified by the first call to print might
get jumbled because the call to system defines its own
standard output buffers. To get around this problem, set the system
variable $| to 1 before calling system.
- Here is one possible solution:
#!/usr/local/bin/perl
@searchletters = ("a", "e", "i", "o", "u");
$inputline = <STDIN>;
foreach $letter (@searchletters) {
printf("searching for $letter...\n");
$location = 0;
while (1) {
$location = index ($inputline, $letter,
$location);
last if ($location == -1);
print("\tfound at location $location\n");
$location += 1;
}
}
- Here is one possible solution:
#!/usr/local/bin/perl
@searchletters = ("a", "e", "i", "o", "u");
$inputline = <STDIN>;
foreach $letter (@searchletters) {
printf("searching for $letter...\n");
$location = length ($inputline);
while (1) {
$location = rindex ($inputline, $letter,
$location);
last if ($location == -1);
print("\tfound at location $location\n");
$location -= 1;
}
}
- Here is one possible solution:
#!/usr/local/bin/perl
@searchletters = ("a", "e", "i", "o", "u");
$inputline = <STDIN>;
$len = length ($inputline);
foreach $letter (@searchletters) {
print ("searching for $letter...\n");
$currpos = 0;
while ($currpos < $len) {
$substring = substr ($inputline, $currpos, 1);
if ($letter eq $substring) {
print("\tfound at location $currpos\n");
}
$currpos++;
}
}
- Here is one possible solution:
#!/usr/local/bin/perl
$_ = <STDIN>; # reads to $_ by default
print ("number of a's found: ", tr/a/a/, "\n");
print ("number of e's found: ", tr/e/e/, "\n");
print ("number of i's found: ", tr/i/i/, "\n");
print ("number of o's found: ", tr/o/o/, "\n");
print ("number of u's found: ", tr/u/u/, "\n");
- Here is one possible solution:
#!/usr/local/bin/perl
$number = <STDIN>;
if ($number =~ /\.|[eE]/) {
printf ("in exponential form: %e\n", $number);
printf ("in fixed-point form: %f\n", $number);
} else {
printf ("in decimal form: %d\n", $number);
printf ("in octal form: 0%o\n", $number);
printf ("in hexadecimal form: 0x%x\n", $number);
}
- This program goes into an infinite loop if index
actually finds the substring xyz. To get around this
problem, increment $lastfound (at the bottom of the loop)
before calling index again.
- Here is one possible solution:
#!/usr/local/bin/perl
$string1 = <STDIN>;
chop ($string1);
$len1 = length ($string1);
$string2 = <STDIN>;
chop ($string2);
$len2 = length ($string2);
if ($len1 % 8 != 0) {
$string1 = "0" x (8 - $len1 % 8) . $string1;
$len1 += 8 - $len1 % 8;
}
if ($len2 % 8 != 0) {
$string2 = "0" x (8 - $len2 % 8) . $string2;
$len2 += 8 - $len2 % 8;
}
if ($len1 > $len2) {
$string2 = "0" x ($len1 - $len2) . $string2;
} else {
$string1 = "0" x ($len2 - $len1) . $string1;
$len1 += ($len2 - $len1);
}
$bytes1 = pack ("b*", $string1);
$bytes2 = pack ("b*", $string2);
$carry = 0;
$count = $len1 - 1;
while ($count >= 0) {
$bit1 = vec ($bytes1, $count, 1);
$bit2 = vec ($bytes2, $count, 1);
$result = ($bit1 + $bit2 + $carry) & 1;
$carry = ($bit1 + $bit2 + $carry) >> 1;
vec ($bytes1, $count, 1) = $result;
$count-;
}
$resultstring = unpack ("b*", $bytes1);
$resultstring = $carry . $resultstring if ($carry > 0);
print ("$resultstring\n");
- Here is one possible solution:
#!/usr/local/bin/perl
$string1 = <STDIN>;
chop ($string1);
$len1 = length ($string1);
$string2 = <STDIN>;
chop ($string2);
$len2 = length ($string2);
if ($len1 % 8 != 0) {
$string1 = "0" x (8 - $len1 % 8) . $string1;
$len1 += 8 - $len1 % 8;
}
if ($len2 % 8 != 0) {
$string2 = "0" x (8 - $len2 % 8) . $string2;
$len2 += 8 - $len2 % 8;
}
if ($len1 > $len2) {
$string2 = "0" x ($len1 - $len2) . $string2;
} else {
$string1 = "0" x ($len2 - $len1) . $string1;
$len1 += ($len2 - $len1);
}
$bytes1 = pack ("h*", $string1);
$bytes2 = pack ("h*", $string2);
$carry = 0;
$count = $len1 - 1;
while ($count >= 0) {
$nybble1 = vec ($bytes1, $count, 4);
$nybble2 = vec ($bytes2, $count, 4);
$result = ($nybble1 + $nybble2 + $carry) & 15;
$carry = ($nybble1 + $nybble2 + $carry) >> 4;
vec ($bytes1, $count, 4) = $result;
$count-;
}
$resultstring = unpack ("h*", $bytes1);
$resultstring = $carry . $resultstring if ($carry > 0);
print ("$resultstring\n");
- Here is one possible solution:
#!/usr/local/bin/perl
$value = <STDIN>;
$value *= 100;
$value = int ($value + 0.5);
$value = sprintf ("%.2f", $value / 100);
print ("$value\n");
- Here is one possible solution:
#!/usr/local/bin/perl
$passwd = crypt ("bluejays", "ez");
$try = 1;
while (1) {
print ("Enter the secret password:\n");
system ("stty -echo");
$guess = <STDIN>;
system ("stty echo");
if (crypt ($guess, substr ($passwd, 0, 2))
eq $passwd) {
print ("Correct!\n");
last;
}
if ($try == 3) {
die ("Sorry! Goodbye!\n");
}
print ("Try again - ");
$try++;
}
- This program is actually reading the low-order bit of the
bit vector. To read the high-order bit, use vec ($packed,
7, 1).
- Here is one possible solution:
#!/usr/local/bin/perl
# This program uses a very dumb sorting algorithm.
@list = (41, 26, 11, 9, 8); # sample list to sort
for ($outer = 0; $outer < @list; $outer++) {
for ($inner = 0; $inner < @list; $inner++) {
if ($list[$inner] > $list[$inner+1]) {
$x = splice (@list, $inner, 1);
splice (@list, $inner+1, 0, $x);
}
}
}
- Here is one possible solution:
#!/usr/local/bin/perl
# assume %oldarray is assigned here
while (($subscript, $value) = each (%oldarray)) {
if (defined ($newarray{$value})) {
print STDERR ("$value already defined\n");
} else {
$newarray{$value} = $subscript;
}
}
- Here is one possible solution:
#!/usr/local/bin/perl
while ($line = <STDIN>) {
@words = split (/\s+/, $line);
@shortwords = grep (/^.{1,5}$/, @words);
print ("@shortwords\n");
}
- Here is one possible solution:
#!/usr/local/bin/perl
$line = <STDIN>;
$line =~ s/^\s+//;
while (1) {
last if ($line eq "");
($word, $line) = split (/\s+/, $line, 2);
print ("$word\n");
}
- This subroutine is trying to remove an element from a list
using unshift. The subroutine should use shift,
not unshift.
- Here is one possible solution:
#!/usr/local/bin/perl
while (($gname, $password, $groupid, $userids)
= getgrent()) {
$garray{$gname} = $userids;
}
foreach $gname (sort keys (%garray)) {
print ("Group $gname:\n");
@userids = split (/\s+/, $garray{$gname});
foreach $userid (sort (@userids)) {
print ("\t$userid\n");
}
}
- Here is one possible solution:
#!/usr/local/bin/perl
while (($name, $d1, $d2, $d3, $d4, $d5, $d6, $homedir) =
getpwent()) {
$dirlist{$name} = $homedir;
}
foreach $name (sort keys (%dirlist)) {
printf ("userid %-15s has home directory %s\n",
$name, $dirlist{$name});
}
- Here is one possible solution:
#!/usr/local/bin/perl
while (@retval = getpwent()) {
$retval[8] = "<null>" if ($retval[8] eq "");
$shellarray{$retval[8]} += 1;
}
foreach $shell (sort count keys (%shellarray)) {
printf ("%-25s %5d %s\n", $shell, $shellarray{$shell},
($shellarray{$shell} == 1 ?
"occurrence" : "occurrences"));
}
sub count {
$shellarray{$b} <=> $shellarray{$a};
}
- Here is one possible solution:
#!/usr/local/bin/perl
$otherid = fork();
if ($otherid == 0) {
# child process
$otherid = getppid();
}
$| = 1; # eliminate print buffers
print ("The process id of the other process is $otherid.\n");
- Here is one possible solution:
#!/usr/local/bin/perl
$port = 2000;
while (getservbyport($port, "tcp")) {
$port++;
}
($d1, $d2, $prototype) = getprotobyname ("tcp");
# in the following, replace "silver" with the name
# of your machine
($d1, $d2, $d3, $d4, $rawaddr) = gethostbyname ("silver");
$serveraddr = pack ("Sna4x8", 2, $port, $rawaddr);
socket (SSOCKET, 2, 1, $prototype) || die ("No socket");
bind (SSOCKET, $serveraddr) || die ("Can't bind");
listen (SSOCKET, 5) || die ("Can't listen");
while (1) {
($clientaddr = accept (SOCKET, SSOCKET))
|| die ("Can't accept");
if (fork() == 0) {
select (SOCKET);
$| = 1;
open (MYFILE, "/u/jqpublic/testfile");
while ($line = <MYFILE>) {
print SOCKET ($line);
}
close (MYFILE);
close (SOCKET);
exit (0);
}
}
- getnetent returns an address as an array of four
bytes, not as a readable address. To convert the address returned
by getnetent to readable form, call unpack.
- Create a file called Zeller.pm like this:
package Zeller;
require Exporter;
@EXPORT = (Zeller);
sub Zeller {
my ($month,$day,$year) = @_;
<<< Insert code from sample here>>>
}
1;
- Then use the file in your Perl script like this:
use Zeller;
$z = Zeller(7,21,1962);
print "\n Day of the week = $z";
- Check if the number of incoming parameters is not three. Use
the call to 'date +\%D'. The answer will return in mm/dd/yy
format. Split the response on '/' to get the month.
$count = scalar (@_);
if ($count != 3) {
$dt = 'date +\%D';
($month,$day,$year) = split($_,'/');
else {
my ($month,$day,$year) = @_;
}
$z = Zeller($month,$day,$year);
- Here is one possible solution:
#!/usr/bin/perl
print 'find . -depth -print ';
- Add the following lines of code to the beginning of the function:
if (scalar(@_) == 0) {
print "\n ================================= \n";
print " Making a black cup of coffee. ";
print "\n ================================= \n";
return;
}