Errata for Perl Cookbook

# See MRE2, p214 sub parse_csv { my $text = shift; # record containing comma-separated values my @fields = (); while ($text =~ m{ # Either some non-quote/non-comma text: ( [^"',] + ) # ...or... | # ...a double-quoted field: (with "" allowed inside) " # field's opening quote; don't save this ( now a field is either (?: [^"] # non-quotes or | "" # adjacent quote pairs ) * # any number ) " # field's closing quote; unsaved }gx) { if (defined $1) { $field = $1; } else { ($field = $2) =~ s/""/"/g; } push @fields, $field; } return @fields; }

The last code example used to read: return quoteword(",", 0, $_[0]); It now reads return quotewords(",", 0, $_[0]);

the rest of them, not a "$".

"use the $X .. $Y construct"

changed } while ( $w >= 1 ); to: while ($w >= 1 || $w == 0)

The middle line of the last code example used to read: printf "%d hour%s %s enough. ", $time, $time==1 ? "" : "s"; $time==1 ? "is" : "are"; It now reads:: printf "%d hour%s %s enough. ", $time, $time==1 ? "" : "s", $time==1 ? "is" : "are";

factors 8 9 96 21 Changed to read: bigfact 8 9 96 2178

my($n, $root, %factors, $factor); It now reads: my($n, %factors, $factor);

"1-366" now reads "0-365."

The seconds were wrong in the output. They now read: There were 265333775 seconds between Nat and Bree

terminating semicolon missing in example; as shown, recipe will abort. was: use Date:Calc qw(Day_of_Week Week_Number Day_of_Week_to_Text) ^ now reads: use Date:Calc qw(Day_of_Week Week_Number Day_of_Week_to_Text);

of the first solution.

"seconds between $t0 and $t1" so it matches the code.

code now reads: first chunk: use Time::HiRes; $t0 = Time::HiRes::time; ## do your operation here $t1 = Time::HiRes::time; $elapsed = $t1 - $t0; # $elapsed is a floating point value, representing number # of seconds between $t1 and $t2 second chunk: use Time::HiRes; print "Press Return when ready: "; $before = Time::HiRes::time(); $line = <>; $elapsed = Time::HiRes::time() - $before; print "You took $elapsed seconds. "; Press return when ready: You took 0.228149 seconds.

print "I have @array marbles ."; into print "I have @array marbles. ";

print "@array"; to print "@array ";

foreach $item (@a, @b) { $item *= 7; print "$item "; } to foreach $item (@a, @b) { $item *= 7; } print "@a @b ";

The code used to read : @MATCHING = (); foreach (@LIST) { push (@MATCHING, $_) if TEST ($_) It now reads: @matching = (); foreach (@list) { push (@matching, $_) if TEST ($_)

The example under Solution used to read: @Sorted = sort { $a <=> $b } Unsorted; It now reads: @sorted = sort { $a <=> $b } @unsorted;

foreach $food (sort { $food_color{$a} cmp $food_color{$b} } ) keys %food_color) { print "$food is $food_color{$food}. "; } to foreach $food (sort { $food_color{$a} cmp $food_color{$b} } keys %food_color) { print "$food is $food_color{$food}. "; }

to "%ingested_color"

next unless /^s*#s+includes+<([^>]+)>/; to next unless /^s*#s*includes*<([^>]+)>/;

i} Deleted the i.

Perl example at the top now reads: $ echo longest | perl -ne 'print "$& " if /(long|longer|longest)+/' long And in the Awk example later: $ echo longest | awk 'match($0, /(long|longer|longest)+/) { print substr($0, RSTART, RLENGTH) } ' longest

$' and $` should be $` and $' (Also, make very certain those are symmetric ticks, not a vertical prime.)

The negated character class [^Wd_] specifies a byte that must not be an alphanumunder, a digit, or an underscore. Should be: The negated character class [^Wd_] specifies a byte that must be neither a non-alphanumunder, a digit, nor an underscore.

"Found number..." 3 times.

and then "</b></i>" to: and then "</i></b>" Also changed corresponding "</b></i>" to: corresponding "</i></b>"

Changed the comment that used to read: # look for a lap It now reads: # look for a lab

in the 3rd paragraph.

they are now plain text.

Changed: m/(w+)s*=s*(.*)s*$/ # keyword is $1, value is $2 to: m/(w+)s*=s*(.*?)s*$/ # keyword is $1, value is $2

"IP Addresses" section now reads: Dotted quads (most IP addresses) # XXX: fails on legal IPs 127.1 and 2130706433 m{ ^ ( d | [01]?dd | 2[0-4]d | 25[0-5] ) . ( d | [01]?dd | 2[0-4]d | 25[0-5] ) . ( d | [01]?dd | 2[0-4]d | 25[0-5] ) . ( d | [01]?dd | 2[0-4]d | 25[0-5] ) $ }x

code example.

to "for writing".

"vec($rout," instead.

% cc -o fionread fionread now reads % cc -o fionread fionread.c

return rmdir($lockname); Should be: rmdir($lockname);

$data = '/usr/share/games/fortune'; to: @ARGV = ('/usr/share/games/fortune') unless @ARGV;

$data = '/usr/share/games/fortunes'; now reads @ARGV = qw( /usr/share/games/fortunes );

$tie = tie(@lines, $FILE, O_RDWR, 0666, $DB_RECNO) or die to $tie = tie(@lines, "DB_File", $FILE, O_RDWR, 0666, $DB_RECNO) or die

Changed /usr/adm to var/log.

... $time, $line, $time); now reads ... $time, $line, $host);

changed: ($file, @addrs) = @ARGV or die "usage: $0 addr ..."; to: ($file, @addrs) = @ARGV or die "usage: $0 file addr ...";

The order of tests was reversed. It used to read: do "$APPDFLT/sysconfig.pl" or do "$ENV{HOME}/.myprogrc"; Now reads: do "$ENV{HOME}/.myprogrc"; or do "$APPDFLT/sysconfig.pl"

The while statement was left-shifted one tabstop.

Changed usage tee... to usage $0... Fixed indent of 3rd }

Changed /usr/adm to var/log

"sizeofor" now reads "sizeof or".

"die" now reads "warn."

unless (! $seen{$dev,$ino}++){ to unless ($seen{$dev,$ino}++){

Changed: move("datafile.new","datafile.dat") to: move("datafile.dat","datafile.new")

return if defined $age && $age > -M; to read: return if defined $age && $age > (stat($_))[9];

Unfortunately, you dare not preserve the directory permissions when you first create the directory, because the directory might lack write permission, and all subsequent link operations will then fail. You have to start out with write permission, then go back and tighten up those that lacked it, after all link creation is complete. (Since lacking write permission is rare, a hash of exceptions could be maintained for the cleanup, or you could make a second pass).

07777 now reads 0777.

chdir $srcdir; now reads chdir $srcdir or die "Can't chdir to $srcdir: $!";

the line $user{$uid} = getpwuid($uid)->name || "#$uid" now reads $user{$uid} = getpwuid($uid) ? getpwuid($uid)->name : "#$uid" Likewise, the line $group{$gid} = getgrgid($gid)->name || "#$gid" now reads $group{$gid} = getgrgid($gid) ? getgrgid($gid)->name : "#$gid"

return sqrt( ($side1 ** 2) + ($side1 ** 2) ); To read: return sqrt( ($side1 ** 2) + ($side2 ** 2) );

Figure 11-3:, the last two line of text now reads: Changed: print "$$a $b "; 3 3 to: print "$$a "; 3

# access Nth item (best) To read: # access item in position N (best)

Code under Solution used to read: "key2" => "value2 ..." Now reads: "key2" => "value2", ...

@keys = keys %$hash; To read: @keys = keys %$href;

my @fields = { split /^([^:]+):s*/m }; to my @fields = split /^([^:]+):s*/m;

push(@Array_of_Records, { @fields }); to push(@Array_of_Records, { map /(.*)/, @fields });

while ($n++ < 20) { insert($root, int(rand(1000)) } to while ($n++ < 20) { insert($root, int(rand(1000))) }

Changed: Poker::Deck::shuffle(23) to: Cards::Poke::shuffle(23)

BEGIN { unless (eval "use $mod") { warn "couldn't load $mod: $@"; } } now reads BEGIN { eval "use $mod"; if ($@) { warn "$@"} }

FineTime.ccc now reads Finetime.c && cc Also, "FineTime.c" in "FineTime.cRunning" was moved to the previous line.

changed the lone semicolon to read: "};"

sub DESTROY { --$BodyCount } # destructor has been changed to: sub DESTROY { --$Body_Count } # destructor

version 0.58, only this line works: @{$p->peers} = ("Wilbur", "Ralph", "Fred"); whereas this one does not, just as the submitted reported: $p->peers( ["Wilbur", "Ralph", "Fred" ] ); # set its peers field However, under Perl release 5.8 and Class::Struct 0.61, I find that {both are, either is} fine. I thus suggest making the two lines in question read: @{$p->peers} = ("Wilbur", "Ralph", "Fred"); # set its peers field $p->peers( ["Wilbur", "Ralph", "Fred" ] ); # also this way in Perl 5.8

Changed the code that read: if (@ISA && $proto->SUPER::can('new') { to read if (@ISA && $proto->SUPER::can('new')) {

Changed "$obj2" to "$obj_target"

sub StrNum($) { to sub StrNum {

Changed: values are Red, Black, RedBlack, and 0 to: values are Red, Black, RedBlack, and RedBlackRedBlackRedBlack

Changed: return StrNum $inverted ? ($s2 . $s1) : ($s1 . $s2); to: return StrNum($inverted ? ($s2 . $s1) : ($s1 . $s2)); In the repeat function, Changed: return StrNum $inverted ? ($s2 x $s1) : ($s1 x $s2); to: return StrNum($inverted ? ($s2 x $s1) : ($s1 x $s2));

push @{$self->{key}}, $value; To read push @{$self->{$key}}, $value;

dbmopen %HASH, FILENAME, 0666 # open database, accessed through %HASH or die "Can't open FILENAME : $! "; To read: dbmopen %HASH, $FILENAME, 0666 # open database, accessed through %HASH or die "Can't open $FILENAME : $! "; Also added a $ to each occurence of FILENAME, KEY, and VALUE.

Changed: untie %hash; # close the database to: untie %HASH; # close the database

Changed: untie %hash; to: untie %HASH;

as the chop on the previous line: next unless defined $href && defined $binary_time;

Changed: # --output=string or --output=string to: # --output=string or --output string

my $f = $menubar->Menubutton(-text => "File", -underline => 0, To read: my $f = $menubar->Menubutton(-text => "Edit", -underline => 0,

(last line of code).

print _POSIX_PIPE_BUF now reads print PIPE_BUF.

socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp')); To read: socket(TO_SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));

INADDR_ANY is a special address, meaning ``listen on any interface''. If you want to restrict it to a particular IP address, add a C<LocalAddr> parameter to your call to C<IO::Socket::INET-E<gt>new>. If coding by hand code, do this: to: If you have several network interfaces, the kernel decides which one to use based on your current routes. If you wish to override this default, add a C<LocalAddr> parameter to your call to C<IO::Socket::INET-E<gt>new>. If coding by hand code, do this:

use Socket; $other_end = getpeername(SOCKET) or die "Couldn't identify other end: $! "; ($port, $iaddr) = unpack_sockaddr_in($other_end); $actual_ip = inet_ntoa($iaddr); $claimed_hostname = gethostbyaddr($iaddr, AF_INET); @name_lookup = gethostbyname($claimed_hostname) or die "Could not look up $claimed_hostname : $! "; @resolved_ips = map { inet_ntoa($_) } @ips_for_hostname[ 4 .. $#ips_for_hostname ]; But look at the misconnect between the variables used in the last two lines! They now read: @name_lookup = gethostbyname($claimed_hostname) or die "Could not look up $claimed_hostname : $! "; @resolved_ips = map { inet_ntoa($_) } @name_lookup[ 4 .. $#name_lookup ];

if ($rv == length $outbuffer{$client} || {$! == POSIX::EWOULDBLOCK) { It should read: if ($rv == length $outbuffer{$client} || $! == POSIX::EWOULDBLOCK) {

Second to last paragraph; The first sentence used to read: We use getsockopt and setsockopt to turn on... It has been changed to read: We use fcntl to turn on...

read "and inet_ntoa to convert back:"

$mailer->open( 'From' => 'Nathan Torkington <gnat@frii.com>', 'To' => 'Tom Chritiansen <tchrist@perl.com>', 'Subject' => 'The Perl Cookbook' ); to: $mailer->open( { From => 'Nathan Torkington <gnat@frii.com>', To => 'Tom Chritiansen <tchrist@perl.com>', Subject => 'The Perl Cookbook' } ); (Note addition of {} around the parameter. Omission of the ')

or die "Can't fetch article $article_number: $! "; To read: or die "Can't fetch article $message_id: $! ";

Changed: die "cannot fork: $!" unless defined ($pid = open(SAFE_KID, "|-")); to: die "cannot fork: $!" unless defined ($pid = open(SAFE_KID, "-|"));

$pid = open(KID_TO_WRITE, "|-"); which was above line: die "cannot fork: $!" unless defined($pid = open(KID_TO_WRITE, "-|"));

my $server = HTTP::Daemon->new(Timeout => 60); To read: my $server = HTTP::Daemon->new(Timeout => 60, LocalPort => 8989);

print header("Program Title"), begin_html(); It now reads: print header("Program Title"), start_html();

my($req, $ans); To read: my $ans;

{ int($seconds / 60) } minutes. To read: { int($total / 60) } minutes.

'total' => $total To read: 'total' => $seconds

'total' => $seconds To read: 'total' => $total

"User-agent: Mozilla ..."

{731} Changed `index.html' to `scooby.html'