Re: Current Issues with perlipc.pod - should they be fixed?
[email protected] (Tom Christiansen) Fri, 03 Dec 2010 22:06:49 -0700
| Newsgroups | perl.perl5.porters,perl.documentation |
|---|---|
| Message-ID | <22826.1291439209@chthon> |
Abigail wrote:
[...]
I don't much like "me too" posts that just dilute the signal for
noise. So I'm bad, because I again find nothing at all to disagree
with in what Abigail has written here.
I'll try to add something anyway.
> Third, the term "modern Perl" makes me twitch in a bad way. I don't
> understand what it is, or why 2010 is the year to jump on this
> bandwagon. (I wonder which piper to follow in 2011).
I have your same twitchiness. It's become almost a "negative
flash word" for me. It reminds me too much of a propaganda
campaign, some marketing hoodwinking, a rebranding by the a
political correctness gone mad.
> But note that unless the feature has actually been removed from
> Perl, its documentation should not disappear.
That's what I mean by bowlderized. There's been stuff taken out
for no good reason, stuff that works just fine. It's the
brainwashing police making sure you think no thoughts they
don't approve of.
>>>> The tone and style of the Perl Documentation as set by Larry and myself
>>>> is
>>>
>>> That's an appeal to authority type argument, which I don't like.
Absolutely. It's recognizing that it was once a garment largely
of one cloth woven, not the ragged patchwork thing it has become.
I actually don't think it's fixable. What the devil is a "wide hex
char" for goodness' sake!? The thing is full of crud like that.
>>> The
>>> tone and style were set when globals were more common.
Oh no, that's not true at all. Most of it was written long after we had
lexically scoped variables, and if you can find something there before we
had dynamically scoped variabled, you have a very good iea.
>>> I think this is open for reasonable people to debate. Adding
>>> "my" costs nothing in obscuring the clarity of the point.
WRONG!!!
<88> WRONG!!!
while (<>) {
chomp;
next unless -f $_; # ignore specials
#...
}
<95> WRONG!!!
print "Can do.\n" if -r $a || -w _ || -x _;
<96> WRONG!!!
stat($filename);
print "Readable\n" if -r _;
print "Writable\n" if -w _;
print "Executable\n" if -x _;
print "Setuid\n" if -u _;
print "Setgid\n" if -g _;
print "Sticky\n" if -k _;
print "Text\n" if -T _;
print "Binary\n" if -B _;
<111> WRONG!!!
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
alarm $timeout;
$nread = sysread SOCKET, $buffer, $size;
alarm 0;
};
if ($@) {
die unless $@ eq "alarm\n"; # propagate unexpected errors
# timed out
}
else {
# didn't
}
<116>
sub tan { sin($_[0]) / cos($_[0]) }
<146> WRONG!!!
# 0 1 2
($package, $filename, $line) = caller;
<148> WRONG!!!
# 0 1 2 3 4
($package, $filename, $line, $subroutine, $hasargs,
<149> WRONG!!! WRONG!!! WRONG!!!
# 5 6 7 8 9 10
$wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash)
= caller($i);
<163> WRONG!!!
$cnt = chmod 0755, "foo", "bar";
chmod 0755, @executables;
$mode = "0644"; chmod $mode, "foo"; # !!! sets mode to
# --w----r-T
$mode = "0644"; chmod oct($mode), "foo"; # this is better
$mode = 0644; chmod $mode, "foo"; # this is best
<165>
open(my $fh, "<", "foo");
my $perm = (stat $fh)[2] & 07777;
chmod($perm | 0600, $fh);
<167> WRONG!!!
use Fcntl qw( :mode );
chmod S_IRWXU|S_IRGRP|S_IXGRP|S_IROTH|S_IXOTH, @executables;
# Identical to the chmod 0755 of the example above.
<172> WRONG!!! WRONG!!!
while (<>) {
chomp; # avoid \n on last field
@array = split(/:/);
# ...
}
<175> WRONG!!! WRONG!!!
chomp($cwd = `pwd`);
chomp($answer = <STDIN>);
<188> WRONG!!! WRONG!!! WRONG!!! WRONG!!!
$cnt = chown $uid, $gid, 'foo', 'bar';
chown $uid, $gid, @filenames;
<191> WRONG!!!
print "User: ";
chomp($user = <STDIN>);
print "Files: ";
chomp($pattern = <STDIN>);
<192> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
($login,$pass,$uid,$gid) = getpwnam($user)
or die "$user not in passwd file";
<193> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
@ary = glob($pattern); # expand filenames
chown $uid, $gid, @ary;
<195> WRONG!!!
use POSIX qw(sysconf _PC_CHOWN_RESTRICTED);
$can_chown_giveaway = not sysconf(_PC_CHOWN_RESTRICTED);
<214>
open(OUTPUT, '|sort >foo') # pipe to sort
or die "Can't start sort: $!";
#... # print stuff to output
close OUTPUT # wait for sort to finish
or warn $! ? "Error closing sort pipe: $!"
: "Exit status $? from sort";
open(INPUT, 'foo') # get sort's results
or die "Can't open 'foo' for input: $!";
<224>
while (EXPR) {
### redo always comes here
do_something;
} continue {
### next always comes here
do_something_else;
# then back the top to re-check EXPR
}
### last always comes here
<231>
sub acos { atan2( sqrt(1 - $_[0] * $_[0]), $_[0] ) }
<240> WRONG!!!
$pwd = (getpwuid($<))[1];
<241> WRONG!!!
system "stty -echo";
print "Password: ";
chomp($word = <STDIN>);
print "\n";
system "stty echo";
<242> WRONG!!!
if (crypt($word, $pwd) ne $pwd) {
die "Sorry...\n";
} else {
print "ok\n";
}
<254> WRONG!!! WRONG!!! WRONG!!! WRONG!!!
# print out history file offsets
dbmopen(%HIST,'/usr/lib/news/history',0666);
while (($key,$val) = each %HIST) {
print $key, ' = ', unpack('L',$val), "\n";
}
dbmclose(%HIST);
<257> WRONG!!!
use DB_File;
dbmopen(%NS_Hist, "$ENV{HOME}/.netscape/history.db")
or die "Can't open netscape history file: $!";
<264> WRONG!!! WRONG!!!
if (@an_array) { print "has array elements\n" }
if (%a_hash) { print "has hash members\n" }
<267> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
print if defined $switch{'D'};
print "$val\n" while defined($val = pop(@ary));
die "Can't readlink $sym: $!"
unless defined($value = readlink $sym);
sub foo { defined &$bar ? &$bar(@_) : die "No bar"; }
$debugging = 0 unless defined $debugging;
<269>
"ab" =~ /a(.*)b/;
<279> WRONG!!!
%hash = (foo => 11, bar => 22, baz => 33);
$scalar = delete $hash{foo}; # $scalar is 11
$scalar = delete @hash{qw(foo bar)}; # $scalar is 22
@array = delete @hash{qw(foo bar baz)}; # @array is (undef,undef,33)
<281> WRONG!!! WRONG!!!
foreach $key (keys %HASH) {
delete $HASH{$key};
}
<282> WRONG!!! WRONG!!!
foreach $index (0 .. $#ARRAY) {
delete $ARRAY[$index];
}
<284> WRONG!!!
delete @HASH{keys %HASH};
<285> WRONG!!!
delete @ARRAY[0 .. $#ARRAY];
<287> WRONG!!!
%HASH = (); # completely empty %HASH
undef %HASH; # forget %HASH ever existed
<288> WRONG!!!
@ARRAY = (); # completely empty @ARRAY
undef @ARRAY; # forget @ARRAY ever existed
<290> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
delete $ref->[$x][$y]{$key};
delete @{$ref->[$x][$y]}{$key1, $key2, @morekeys};
<291> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
delete $ref->[$x][$y][$index];
delete @{$ref->[$x][$y]}[$index1, $index2, @moreindices];
<295>
die "Can't cd to spool: $!\n" unless chdir '/usr/spool/news';
chdir '/usr/spool/news' or die "Can't cd to spool: $!\n"
<298>
die "/etc/games is no good";
die "/etc/games is no good, stopped";
<300>
/etc/games is no good at canasta line 123.
/etc/games is no good, stopped at canasta line 123.
<302>
eval { ... };
die unless $@ =~ /Expected exception/;
<306>
exit $! if $!; # errno
exit $? >> 8 if $? >> 8; # child exit status
exit 255; # last resort
<309>
use Scalar::Util "blessed";
<310>
eval { ... ; die Some::Module::Exception->new( FOO => "bar" ) };
if (my $ev_err = $@) {
if (blessed($ev_err) && $ev_err->isa("Some::Module::Exception")) {
# handle Some::Module::Exception
}
else {
# handle all other possible exceptions
}
}
<313> WRONG!!!
die @_ if $^S;
<323>
do 'stat.pl';
<325>
eval `cat stat.pl`;
<330> WRONG!!!
# read in config files: system first, then user
for $file ("/share/prog/defaults.rc",
"$ENV{HOME}/.someprogrc")
{
unless ($return = do $file) {
warn "couldn't parse $file: $@" if $@;
warn "couldn't do $file: $!" unless defined $return;
warn "couldn't run $file" unless $return;
}
}
<341> WRONG!!! WRONG!!! WRONG!!!
while (($key, $value) = each %hash) {
print $key, "\n";
delete $hash{$key}; # This is safe
}
<343> WRONG!!! WRONG!!!
while (($key,$value) = each %ENV) {
print "$key=$value\n";
}
<345> WRONG!!! WRONG!!! WRONG!!!
while (($key,$value) = each $hashref) { ... }
<354> WRONG!!!
# reset line numbering on each input file
while (<>) {
next if /^\s*#/; # skip comments
print "$.\t$_";
} continue {
close ARGV if eof; # Not eof()!
}
<355> WRONG!!!
# insert dashes just before last line of last file
while (<>) {
if (eof()) { # check for end of last file
print "--------------\n";
}
print;
last if eof(); # needed if we're reading from a terminal
}
<368> WRONG!!! WRONG!!!
# make divide-by-zero nonfatal
eval { $answer = $a / $b; }; warn $@ if $@;
<369> WRONG!!! WRONG!!!
# same thing, but less efficient
eval '$answer = $a / $b'; warn $@ if $@;
<370> WRONG!!!
# a compile-time error
eval { $answer = }; # WRONG
<371> WRONG!!!
# a run-time error
eval '$answer ='; # sets $@
<373> WRONG!!! WRONG!!!
# a private exception trap for divide-by-zero
eval { local $SIG{'__DIE__'}; $answer = $a / $b; };
warn $@ if $@;
<375>
# __DIE__ hooks may modify error messages
{
local $SIG{'__DIE__'} =
sub { (my $x = $_[0]) =~ s/foo/bar/g; die $x };
eval { die "foo lives here" };
print $@ if $@; # prints "bar lives here"
}
<378> WRONG!!! WRONG!!!
eval $x; # CASE 1
eval "$x"; # CASE 2
<379> WRONG!!! WRONG!!!
eval '$x'; # CASE 3
eval { $x }; # CASE 4
<380> WRONG!!! WRONG!!!
eval "\$$x++"; # CASE 5
$$x++; # CASE 6
<383>
# alter $@ on nefarious repugnancy only
{
my $e;
{
local $@; # protect existing $@
eval { test_repugnancy() };
# $@ =~ /nefarious/ and die $@; # DOES NOT WORK
$@ =~ /nefarious/ and $e = $@;
}
die $e if defined $e
}
<390>
exec ('foo') or print STDERR "couldn't exec foo: $!";
{ exec ('foo') }; print STDERR "couldn't exec foo: $!";
<392>
exec '/bin/echo', 'Your arguments are: ', @ARGV;
exec "sort $outfile | uniq";
<394>
$shell = '/bin/csh';
exec $shell '-sh'; # pretend it's a login shell
<396>
exec {'/bin/csh'} '-sh'; # pretend it's a login shell
<399> WRONG!!!
@args = ( "echo surprise" );
<400> WRONG!!! WRONG!!!
exec @args; # subject to shell escapes
# if @args == 1
exec { $args[0] } @args; # safe even with one-arg list
<406> WRONG!!! WRONG!!!
print "Exists\n" if exists $hash{$key};
print "Defined\n" if defined $hash{$key};
print "True\n" if $hash{$key};
<408> WRONG!!! WRONG!!!
print "Exists\n" if exists $array[$index];
print "Defined\n" if defined $array[$index];
print "True\n" if $array[$index];
<411>
print "Exists\n" if exists &subroutine;
print "Defined\n" if defined &subroutine;
<413> WRONG!!! WRONG!!! WRONG!!!
if (exists $ref->{A}->{B}->{$key}) { }
if (exists $hash{A}{B}{$key}) { }
<414> WRONG!!! WRONG!!! WRONG!!!
if (exists $ref->{A}->{B}->[$ix]) { }
if (exists $hash{A}{B}[$ix]) { }
<415> WRONG!!! WRONG!!!
if (exists &{$ref->{A}{B}{$key}}) { }
<417> WRONG!!!
undef $ref;
if (exists $ref->{"Some key"}) { }
print $ref; # prints HASH(0x80d3d5c)
<420>
exists ⊂ # OK
exists &sub(); # Error
<424> WRONG!!!
$ans = <STDIN>;
exit 0 if $ans =~ /^[Xx]/;
<433>
use Fcntl;
<435> WRONG!!! WRONG!!!
use Fcntl;
fcntl($filehandle, F_GETFL, $packed_return_buffer)
or die "can't fcntl F_GETFL: $!";
<439>
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
<440> WRONG!!!
$flags = fcntl(REMOTE, F_GETFL, 0)
or die "Can't get flags for the socket: $!\n";
<441> WRONG!!!
$flags = fcntl(REMOTE, F_SETFL, $flags | O_NONBLOCK)
or die "Can't set flags for the socket: $!\n";
<445> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
if (fileno(THIS) == fileno(THAT)) {
print "THIS and THAT are dups\n";
}
<456>
use Fcntl qw(:flock SEEK_END); # import LOCK_* and SEEK_END constants
<457>
sub lock {
my ($fh) = @_;
flock($fh, LOCK_EX) or die "Cannot lock mailbox - $!\n";
<458> WRONG!!!
# and, in case someone appended while we were waiting...
seek($fh, 0, SEEK_END) or die "Cannot seek - $!\n";
}
<459>
sub unlock {
my ($fh) = @_;
flock($fh, LOCK_UN) or die "Cannot unlock mailbox - $!\n";
}
<460>
open(my $mbox, ">>", "/usr/spool/mail/$ENV{'USER'}")
or die "Can't open mailbox: $!";
<461> WRONG!!! WRONG!!!
lock($mbox);
print $mbox $msg,"\n\n";
unlock($mbox);
<471> WRONG!!! WRONG!!!
format Something =
Test: @<<<<<<<< @||||| @>>>>>
$str, $%, '$' . int($num)
.
<472> WRONG!!! WRONG!!! WRONG!!!
$str = "widget";
$num = $cost/$quantity;
$~ = 'Something';
write;
<480> WRONG!!!
if ($BSD_STYLE) {
system "stty cbreak </dev/tty >/dev/tty 2>&1";
}
else {
system "stty", '-icanon', 'eol', "\001";
}
<481> WRONG!!!
$key = getc(STDIN);
<482> WRONG!!!
if ($BSD_STYLE) {
system "stty -cbreak </dev/tty >/dev/tty 2>&1";
}
else {
system 'stty', 'icanon', 'eol', '^@'; # ASCII NUL
}
print "\n";
<487> WRONG!!!
$login = getlogin || getpwuid($<) || "Kilroy";
<491> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
use Socket;
$hersockaddr = getpeername(SOCK);
($port, $iaddr) = sockaddr_in($hersockaddr);
$herhostname = gethostbyaddr($iaddr, AF_INET);
$herstraddr = inet_ntoa($iaddr);
<530> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
($name,$passwd,$uid,$gid,
$quota,$comment,$gcos,$dir,$shell,$expire) = getpw*
($name,$passwd,$gid,$members) = getgr*
($name,$aliases,$addrtype,$length,@addrs) = gethost*
($name,$aliases,$addrtype,$net) = getnet*
($name,$aliases,$proto) = getproto*
($name,$aliases,$port,$proto) = getserv*
<534> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
$uid = getpwnam($name);
$name = getpwuid($num);
$name = getpwent();
$gid = getgrnam($name);
$name = getgrgid($num);
$name = getgrent();
#etc.
<538> WRONG!!! WRONG!!! WRONG!!! WRONG!!!
($a,$b,$c,$d) = unpack('W4',$addr[0]);
<540> WRONG!!! WRONG!!!
use Socket;
$iaddr = inet_aton("127.1"); # or whatever address
$name = gethostbyaddr($iaddr, AF_INET);
<541> WRONG!!! WRONG!!!
# or going the other way
$straddr = inet_ntoa($iaddr);
<543> WRONG!!! WRONG!!!
use Socket;
$packed_ip = gethostbyname("www.perl.org");
if (defined $packed_ip) {
$ip_address = inet_ntoa($packed_ip);
}
<546> WRONG!!! WRONG!!! WRONG!!!
use File::stat;
use User::pwent;
$is_his = (stat($filename)->uid == pwent($whoever)->uid);
<550> WRONG!!! WRONG!!! WRONG!!! WRONG!!!
use Socket;
$mysockaddr = getsockname(SOCK);
($port, $myaddr) = sockaddr_in($mysockaddr);
printf "Connect to %s [%s]\n",
scalar gethostbyaddr($myaddr, AF_INET),
inet_ntoa($myaddr);
<555>
use Socket qw(:all);
<556>
defined(my $tcp = getprotobyname("tcp"))
or die "Could not determine the protocol number for tcp";
# my $tcp = IPPROTO_TCP; # Alternative
my $packed = getsockopt($socket, $tcp, TCP_NODELAY)
or die "getsockopt TCP_NODELAY: $!";
my $nodelay = unpack("I", $packed);
print "Nagle's algorithm is turned ", $nodelay ? "off\n" : "on\n";
<562> WRONG!!!
@many = glob "{apple,tomato,cherry}={green,yellow,red}";
<574> WRONG!!!
goto ("FOO", "BAR", "GLARCH")[$i];
<582> WRONG!!! WRONG!!!
@foo = grep(!/^#/, @bar); # weed out comments
<584> WRONG!!! WRONG!!!
@foo = grep {!/^#/} @bar; # weed out comments
<591>
print hex '0xAf'; # prints '175'
print hex 'aF'; # same
<603>
require "sys/ioctl.ph"; # probably in $Config{archlib}/sys/ioctl.ph
<606>
if OS returns: then Perl returns:
-1 undefined value
0 string "0 but true"
anything else that number
<608> WRONG!!!
$retval = ioctl(...) || -1;
printf "System returned %d\n", $retval;
<612> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
$rec = join(':', $login,$passwd,$uid,$gid,$gcos,$home,$shell);
<620> WRONG!!! WRONG!!!
@keys = keys %ENV;
@values = values %ENV;
while (@keys) {
print pop(@keys), '=', pop(@values), "\n";
}
<622> WRONG!!! WRONG!!!
foreach $key (sort(keys %ENV)) {
print $key, '=', $ENV{$key}, "\n";
}
<625> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
foreach $key (sort { $hash{$b} <=> $hash{$a} } keys %hash) {
printf "%4d %s\n", $hash{$key}, $key;
}
<627> WRONG!!!
keys %hash = 200;
<630> WRONG!!! WRONG!!!
for (keys $hashref) { ... }
for (keys $obj->get_arrayref) { ... }
<635> WRONG!!! WRONG!!! WRONG!!!
$cnt = kill 1, $child1, $child2;
kill 9, @goners;
<643> WRONG!!!
LINE: while (<STDIN>) {
last LINE if /^$/; # exit when done with header
#...
}
<695> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
# 0 1 2 3 4 5 6 7 8
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime(time);
<698> WRONG!!! WRONG!!! WRONG!!!
my @abbr = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
print "$abbr[$mon] $mday";
# $mon=9, $mday=18 gives "Oct 18"
<700> WRONG!!!
$year += 1900;
<703> WRONG!!! WRONG!!!
$year = sprintf("%02d", $year % 100);
<708> WRONG!!!
$now_string = localtime; # e.g., "Thu Oct 13 04:54:34 1994"
<711> WRONG!!!
use POSIX qw(strftime);
$now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
# or for GMT formatted appropriately for your locale:
$now_string = strftime "%a %b %e %H:%M:%S %Y", gmtime;
<722>
sub log10 {
my $n = shift;
return log($n)/log(10);
}
<733> WRONG!!! WRONG!!!
@chars = map(chr, @nums);
<735> WRONG!!! WRONG!!!
%hash = map { get_a_key_for($_) => $_ } @array;
<737> WRONG!!! WRONG!!! WRONG!!!
%hash = ();
foreach (@array) {
$hash{get_a_key_for($_)} = $_;
}
<741> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
%hash = map { "\L$_" => 1 } @array # perl guesses EXPR. wrong
%hash = map { +"\L$_" => 1 } @array # perl guesses BLOCK. right
%hash = map { ("\L$_" => 1) } @array # this also works
%hash = map { lc($_) => 1 } @array # as does this.
%hash = map +( lc($_) => 1 ), @array # this is EXPR and works!
<742> WRONG!!!
%hash = map ( lc($_), 1 ), @array # evaluates to (1, @array)
<744> WRONG!!!
@hashes = map +{ lc($_) => 1 }, @array # EXPR, so needs comma at end
<755>
use IPC::SysV;
<772> WRONG!!!
LINE: while (<STDIN>) {
next LINE if /^#/; # discard comments
#...
}
<786> WRONG!!!
$val = oct($val) if $val =~ /^0/;
<788> WRONG!!! WRONG!!! WRONG!!!
$dec_perms = (stat("filename"))[2] & 07777;
$oct_perm_str = sprintf "%o", $perms;
<798>
open(my $fh, '<', "input.txt") or die $!;
<800>
open(my $fh, '>', "output.txt") or die $!;
<813>
open(my $fh, "<:encoding(UTF-8)", "filename")
|| die "can't open UTF-8 encoded filename: $!";
<819>
open(my $tmp, "+>", undef) or die ...
<822> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
open($fh, '>', \$variable) || ..
<824> WRONG!!!
close STDOUT;
open STDOUT, '>', \$variable or die "Can't open STDOUT: $!";
<826> WRONG!!!
$ARTICLE = 100;
open ARTICLE or die "Can't find article $ARTICLE: $!\n";
while (<ARTICLE>) {...
<827>
open(LOG, '>>/usr/spool/news/twitlog'); # (log is reserved)
# if the open fails, output is discarded
<828>
open(my $dbase, '+<', 'dbase.mine') # open for update
or die "Can't open 'dbase.mine' for update: $!";
<829>
open(my $dbase, '+<dbase.mine') # ditto
or die "Can't open 'dbase.mine' for update: $!";
<830> WRONG!!!
open(ARTICLE, '-|', "caesar <$article") # decrypt article
or die "Can't start caesar: $!";
<831> WRONG!!!
open(ARTICLE, "caesar <$article |") # ditto
or die "Can't start caesar: $!";
<832>
open(EXTRACT, "|sort >Tmp$$") # $$ is our process id
or die "Can't start sort: $!";
<833> WRONG!!! WRONG!!! WRONG!!! WRONG!!!
# in-memory files
open(MEMORY,'>', \$var)
or die "Can't open memory file: $!";
print MEMORY "foo!\n"; # output will appear in $var
<834>
# process argument list of files along with any includes
<835> WRONG!!!
foreach $file (@ARGV) {
process($file, 'fh00');
}
<836>
sub process {
my($filename, $input) = @_;
$input++; # this is a string increment
unless (open($input, $filename)) {
print STDERR "Can't open $filename: $!\n";
return;
}
<837>
local $_;
while (<$input>) { # note use of indirection
if (/^#include "(.*)"/) {
process($1, $input);
next;
}
#... # whatever
}
}
<841> WRONG!!!
#!/usr/bin/perl
open my $oldout, ">&STDOUT" or die "Can't dup STDOUT: $!";
open OLDERR, ">&", \*STDERR or die "Can't dup STDERR: $!";
<842>
open STDOUT, '>', "foo.out" or die "Can't redirect STDOUT: $!";
open STDERR, ">&STDOUT" or die "Can't dup STDOUT: $!";
<843>
select STDERR; $| = 1; # make unbuffered
select STDOUT; $| = 1; # make unbuffered
<844>
print STDOUT "stdout 1\n"; # this works for
print STDERR "stderr 1\n"; # subprocesses too
<845> WRONG!!!
open STDOUT, ">&", $oldout or die "Can't dup \$oldout: $!";
open STDERR, ">&OLDERR" or die "Can't dup OLDERR: $!";
<846>
print STDOUT "stdout 2\n";
print STDERR "stderr 2\n";
<848> WRONG!!! WRONG!!!
# open for input, reusing the fileno of $fd
open(FILEHANDLE, "<&=$fd")
<850> WRONG!!! WRONG!!!
open(FILEHANDLE, "<&=", $fd)
<852> WRONG!!! WRONG!!! WRONG!!!
# open for append, using the fileno of OLDFH
open(FH, ">>&=", OLDFH)
<854> WRONG!!! WRONG!!!
open(FH, ">>&=OLDFH")
<860> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
open(FOO, "|tr '[a-z]' '[A-Z]'");
open(FOO, '|-', "tr '[a-z]' '[A-Z]'");
open(FOO, '|-') || exec 'tr', '[a-z]', '[A-Z]';
open(FOO, '|-', "tr", '[a-z]', '[A-Z]');
<861> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
open(FOO, "cat -n '$file'|");
open(FOO, '-|', "cat -n '$file'");
open(FOO, '-|') || exec 'cat', '-n', $file;
open(FOO, '-|', "cat", '-n', $file);
<868> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
$filename =~ s/(.*\.gz)\s*$/gzip -dc < $1|/;
open(FH, $filename) or die "Can't open $filename: $!";
<870> WRONG!!! WRONG!!!
open(FOO, '<', $file);
<872> WRONG!!! WRONG!!!
$file =~ s#^(\s)#./$1#;
open(FOO, "< $file\0");
<874> WRONG!!!
open IN, $ARGV[0];
<876> WRONG!!!
open IN, '<', $ARGV[0];
<879> WRONG!!! WRONG!!! WRONG!!!
use IO::Handle;
sysopen(HANDLE, $path, O_RDWR|O_CREAT|O_EXCL)
or die "sysopen $path: $!";
$oldfh = select(HANDLE); $| = 1; select($oldfh);
print HANDLE "stuff $$\n";
seek(HANDLE, 0, 0);
print "File contains: ", <HANDLE>;
<881>
use IO::File;
#...
sub read_myfile_munged {
my $ALL = shift;
my $handle = IO::File->new;
open($handle, "myfile") or die "myfile: $!";
$first = <$handle>
or return (); # Automatically closed here.
mung $first or die "mung failed"; # Or here.
return $first, <$handle> if $ALL; # Or here.
$first; # Or here.
}
<897>
our $foo;
our($bar, $baz);
<899>
package Foo;
our $bar; # declares $Foo::bar for rest of lexical scope
$bar = 20;
<900> WRONG!!!
package Bar;
print $bar; # prints 20, as it refers to $Foo::bar
<902>
use warnings;
package Foo;
our $bar; # declares $Foo::bar for rest of lexical scope
$bar = 20;
<903>
package Bar;
our $bar = 30; # declares $Bar::bar for rest of lexical scope
print $bar; # prints 30
<904>
our $bar; # emits warning but has no other effect
print $bar; # still prints 30
<911>
a A string with arbitrary binary data, will be null padded.
A A text (ASCII) string, will be space padded.
Z A null-terminated (ASCIZ) string, will be null padded.
<912>
b A bit string (ascending bit order inside each byte, like vec()).
B A bit string (descending bit order inside each byte).
h A hex string (low nybble first).
H A hex string (high nybble first).
<913>
c A signed char (8-bit) value.
C An unsigned char (octet) value.
W An unsigned char value (can be greater than 255).
<914>
s A signed short (16-bit) value.
S An unsigned short value.
<915>
l A signed long (32-bit) value.
L An unsigned long value.
<916>
q A signed quad (64-bit) value.
Q An unsigned quad value.
(Quads are available only if your system supports 64-bit
integer values _and_ if Perl has been compiled to support those.
Raises an exception otherwise.)
<917>
i A signed integer value.
I A unsigned integer value.
(This 'integer' is _at_least_ 32 bits wide. Its exact
size depends on what a local C compiler calls 'int'.)
<918>
n An unsigned short (16-bit) in "network" (big-endian) order.
N An unsigned long (32-bit) in "network" (big-endian) order.
v An unsigned short (16-bit) in "VAX" (little-endian) order.
V An unsigned long (32-bit) in "VAX" (little-endian) order.
<919>
j A Perl internal signed integer value (IV).
J A Perl internal unsigned integer value (UV).
<920>
f A single-precision float in native format.
d A double-precision float in native format.
<921>
F A Perl internal floating-point value (NV) in native format
D A float of long-double precision in native format.
(Long doubles are available only if your system supports long
double values _and_ if Perl has been compiled to support those.
Raises an exception otherwise.)
<922>
p A pointer to a null-terminated string.
P A pointer to a structure (fixed-length string).
<923>
u A uuencoded string.
U A Unicode character number. Encodes to a character in character mode
and UTF-8 (or UTF-EBCDIC in EBCDIC platforms) in byte mode.
<924>
w A BER compressed integer (not an ASN.1 BER, see perlpacktut for
details). Its bytes represent an unsigned integer in base 128,
most significant digit first, with as few digits as possible. Bit
eight (the high bit) is set on each byte except the last.
<925>
x A null byte (a.k.a ASCII NUL, "\000", chr(0))
X Back up a byte.
@ Null-fill or truncate to absolute position, counted from the
start of the innermost ()-group.
. Null-fill or truncate to absolute position specified by the value.
( Start of a ()-group.
<927>
! sSlLiI Forces native (short, long, int) sizes instead
of fixed (16-/32-bit) sizes.
<928>
xX Make x and X act as alignment commands.
<929>
nNvV Treat integers as signed instead of unsigned.
<930>
@. Specify position as byte offset in the internal
representation of the packed string. Efficient but
dangerous.
<931>
> sSiIlLqQ Force big-endian byte-order on the type.
jJfFdDpP (The "big end" touches the construct.)
<932>
< sSiIlLqQ Force little-endian byte-order on the type.
jJfFdDpP (The "little end" touches the construct.)
<986>
unpack("W/a", "\004Gurusamy") gives ("Guru")
unpack("a3/A A*", "007 Bond J ") gives (" Bond", "J")
unpack("a3 x2 /A A*", "007: Bond, J.") gives ("Bond, J", ".")
<987>
pack("n/a* w/a","hello,","world") gives "\000\006hello,\005world"
pack("a/W2", ord("a") .. ord("z")) gives "2ab"
<992>
printf "format s is %d, s! is %d\n",
length pack("s"), length pack("s!");
<993>
printf "format l is %d, l! is %d\n",
length pack("l"), length pack("l!");
<996>
$ perl -V:{short,int,long{,long}}size
shortsize='2';
intsize='4';
longsize='4';
longlongsize='8';
<998>
use Config;
print $Config{shortsize}, "\n";
print $Config{intsize}, "\n";
print $Config{longsize}, "\n";
print $Config{longlongsize}, "\n";
<1002>
0x12 0x34 0x56 0x78 # big-endian
0x78 0x56 0x34 0x12 # little-endian
<1006>
0x56 0x78 0x12 0x34
0x34 0x12 0x78 0x56
<1008>
printf("%#02x ", $_) for unpack("W*", pack L=>0x12345678);
<1010>
use Config;
print "$Config{byteorder}\n";
<1012>
$ perl -V:byteorder
<1038>
pack("@1A((@2A)@3A)", qw[X Y Z])
<1042>
struct {
char c; /* one signed, 8-bit character */
double d;
char cc[2];
}
<1053> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
$foo = pack("WWWW",65,66,67,68);
# foo eq "ABCD"
$foo = pack("W4",65,66,67,68);
# same thing
$foo = pack("W4",0x24b6,0x24b7,0x24b8,0x24b9);
# same thing with Unicode circled letters.
$foo = pack("U4",0x24b6,0x24b7,0x24b8,0x24b9);
# same thing with Unicode circled letters. You don't get the UTF-8
# bytes because the U at the start of the format caused a switch to
# U0-mode, so the UTF-8 bytes get joined into characters
$foo = pack("C0U4",0x24b6,0x24b7,0x24b8,0x24b9);
# foo eq "\xe2\x92\xb6\xe2\x92\xb7\xe2\x92\xb8\xe2\x92\xb9"
# This is the UTF-8 encoding of the string in the previous example
<1054> WRONG!!!
$foo = pack("ccxxcc",65,66,67,68);
# foo eq "AB\0\0CD"
<1055> WRONG!!!
# NOTE: The examples above featuring "W" and "c" are true
# only on ASCII and ASCII-derived systems such as ISO Latin 1
# and UTF-8. On EBCDIC systems, the first example would be
# $foo = pack("WWWW",193,194,195,196);
<1056> WRONG!!!
$foo = pack("s2",1,2);
# "\001\000\002\000" on little-endian
# "\000\001\000\002" on big-endian
<1057> WRONG!!!
$foo = pack("a4","abcd","x","y","z");
# "abcd"
<1058> WRONG!!!
$foo = pack("aaaa","abcd","x","y","z");
# "axyz"
<1059> WRONG!!!
$foo = pack("a14","abcdefg");
# "abcdefg\0\0\0\0\0\0\0"
<1060> WRONG!!!
$foo = pack("i9pl", gmtime);
# a real struct tm (on my system anyway)
<1061> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
$utmp_template = "Z8 Z8 Z16 L";
$utmp = pack($utmp_template, @utmp1);
# a struct utmp (BSDish)
<1062> WRONG!!! WRONG!!!
@utmp2 = unpack($utmp_template, $utmp);
# "@utmp1" eq "@utmp2"
<1063>
sub bintodec {
unpack("N", pack("B32", substr("0" x 32 . shift, -32)));
}
<1064> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
$foo = pack('sx2l', 12, 34);
# short 12, two zero bytes padding, long 34
$bar = pack('s@4l', 12, 34);
# short 12, zero fill to position 4, long 34
# $foo eq $bar
$baz = pack('s.l', 12, 4, 34);
# short 12, zero fill to position 4, long 34
<1065> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
$foo = pack('nN', 42, 4711);
# pack big-endian 16- and 32-bit unsigned integers
$foo = pack('S>L>', 42, 4711);
# exactly the same
$foo = pack('s<l<', -42, 4711);
# pack little-endian 16- and 32-bit signed integers
$foo = pack('(sl)<', -42, 4711);
# exactly the same
<1094> WRONG!!! WRONG!!! WRONG!!!
print { $files[$i] } "stuff\n";
print { $OK ? STDOUT : STDERR } "stuff\n";
<1105> WRONG!!! WRONG!!! WRONG!!!
for $value (LIST) {
$ARRAY[++$#ARRAY] = $value;
}
<1120>
my $sentence = 'The quick brown fox jumped over the lazy dog';
my $substring = 'quick.*?fox';
$sentence =~ s{$substring}{big bad wolf};
<1123>
my $sentence = 'The quick brown fox jumped over the lazy dog';
my $substring = 'quick.*?fox';
$sentence =~ s{\Q$substring\E}{big bad wolf};
<1125>
my $sentence = 'The quick brown fox jumped over the lazy dog';
my $substring = 'quick.*?fox';
my $quoted_substring = quotemeta($substring);
$sentence =~ s{$quoted_substring}{big bad wolf};
<1131>
int(rand(10))
<1143> WRONG!!! WRONG!!!
opendir(my $dh, $some_dir) || die "can't opendir $some_dir: $!";
@dots = grep { /^\./ && -f "$some_dir/$_" } readdir($dh);
closedir $dh;
<1145> WRONG!!! WRONG!!!
opendir(my $dh, $some_dir) || die;
while(readdir $dh) {
print "$some_dir/$_\n";
}
closedir $dh;
<1151> WRONG!!!
$line = <STDIN>;
$line = readline(*STDIN); # same thing
<1153> WRONG!!!
while ( ! eof($fh) ) {
defined( $_ = <$fh> ) or die "readline failed: $!";
...
}
<1155>
foreach my $arg (@ARGV) {
open(my $fh, $arg) or warn "Can't open $arg: $!";
<1156> WRONG!!! WRONG!!!
while ( ! eof($fh) ) {
defined( $_ = <$fh> )
or die "readline failed for $arg: $!";
...
}
}
<1169> WRONG!!! WRONG!!! WRONG!!!
# a simpleminded Pascal comment stripper
# (warning: assumes no { or } in strings)
LINE: while (<STDIN>) {
while (s|({.*}.*){.*}|$1 |) {}
s|{.*}| |;
if (s|{.*| |) {
$front = $_;
while (<STDIN>) {
if (/}/) { # end of comment?
s|^|$front\{|;
redo LINE;
}
}
}
print;
}
<1176>
SCALAR
ARRAY
HASH
CODE
REF
GLOB
LVALUE
FORMAT
IO
VSTRING
Regexp
<1178> WRONG!!! WRONG!!!
if (ref($r) eq "HASH") {
print "r is a reference to a hash.\n";
}
unless (ref($r)) {
print "r is not a reference at all.\n";
}
<1192>
require v5.6.1; # run time version check
require 5.6.1; # ditto
require 5.006_001; # ditto; preferred for backwards compatibility
<1194> WRONG!!!
sub require {
my ($filename) = @_;
if (exists $INC{$filename}) {
return 1 if $INC{$filename};
die "Compilation failed in require";
}
my ($realfilename,$result);
ITER: {
foreach $prefix (@INC) {
$realfilename = "$prefix/$filename";
if (-f $realfilename) {
$INC{$filename} = $realfilename;
$result = do $realfilename;
last ITER;
}
}
die "Can't find $filename in \@INC";
}
if ($@) {
$INC{$filename} = undef;
die $@;
} elsif (!$result) {
delete $INC{$filename};
die "$filename did not return true value";
} else {
return $result;
}
}
<1199>
require Foo::Bar; # a splendid bareword
<1202> WRONG!!!
$class = 'Foo::Bar';
require $class; # $class is not a bareword
#or
require "Foo::Bar"; # not a bareword because of the ""
<1204> WRONG!!!
eval "require $class";
<1219>
push @INC, \&my_sub;
sub my_sub {
my ($coderef, $filename) = @_; # $coderef is \&my_sub
...
}
<1221>
push @INC, [ \&my_sub, $x, $y, ... ];
sub my_sub {
my ($arrayref, $filename) = @_;
# Retrieve $x, $y, ...
my @parameters = @$arrayref[1..$#$arrayref];
...
}
<1223>
# In Foo.pm
package Foo;
sub new { ... }
sub Foo::INC {
my ($self, $filename) = @_;
...
}
<1224>
# In the main program
push @INC, Foo->new(...);
<1230>
reset 'X'; # reset all X variables
reset 'a-z'; # reset lower case variables
reset; # just reset ?one-time? searches
<1238>
print join(", ", reverse "world", "Hello"); # Hello, world
<1239>
print scalar reverse "dlrow ,", "olleH"; # Hello, world
<1241> WRONG!!!
$_ = "dlrow ,olleH";
print reverse; # No output, list context
print scalar reverse; # Hello, world
<1244> WRONG!!! WRONG!!!
%by_name = reverse %by_address; # Invert the hash
<1263> WRONG!!! WRONG!!! WRONG!!! WRONG!!!
@counts = ( scalar @a, scalar @b, scalar @c );
<1267> WRONG!!! WRONG!!!
print uc(scalar(&foo,$bar)),$baz;
<1269> WRONG!!! WRONG!!!
&foo;
print(uc($bar),$baz);
<1276> WRONG!!!
seek(TEST,0,1);
<1279> WRONG!!! WRONG!!! WRONG!!!
for (;;) {
for ($curpos = tell(FILE); $_ = <FILE>;
$curpos = tell(FILE)) {
# search for some stuff and put it into files
}
sleep($for_a_while);
seek(FILE, $curpos, 0);
}
<1285> WRONG!!! WRONG!!!
select(REPORT1);
$^ = 'report1_top';
select(REPORT2);
$^ = 'report2_top';
<1287> WRONG!!! WRONG!!! WRONG!!!
$oldfh = select(STDERR); $| = 1; select($oldfh);
<1289>
use IO::Handle;
STDERR->autoflush(1);
<1292> WRONG!!! WRONG!!! WRONG!!!
$rin = $win = $ein = '';
vec($rin,fileno(STDIN),1) = 1;
vec($win,fileno(STDOUT),1) = 1;
$ein = $rin | $win;
<1294> WRONG!!!
sub fhbits {
my(@fhlist) = split(' ',$_[0]);
my($bits);
for (@fhlist) {
vec($bits,fileno($_),1) = 1;
}
$bits;
}
$rin = fhbits('STDIN TTY SOCK');
<1296> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
($nfound,$timeleft) =
select($rout=$rin, $wout=$win, $eout=$ein, $timeout);
<1298> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
$nfound = select($rout=$rin, $wout=$win, $eout=$ein, undef);
<1302>
select(undef, undef, undef, 0.25);
<1309>
use IPC::SysV;
<1315> WRONG!!! WRONG!!! WRONG!!!
$semop = pack("s!3", $semnum, -1, 0);
die "Semaphore trouble: $!\n" unless semop($semid, $semop);
<1328> WRONG!!! WRONG!!! WRONG!!! WRONG!!!
use Socket qw(IPPROTO_TCP TCP_NODELAY);
setsockopt($socket, IPPROTO_TCP, TCP_NODELAY, 1);
<1336>
use IPC::SysV;
<1345> WRONG!!! WRONG!!! WRONG!!!
shutdown(SOCKET, 0); # I/we have stopped reading data
shutdown(SOCKET, 1); # I/we have stopped writing data
shutdown(SOCKET, 2); # I/we have stopped using this socket
<1352>
sub asin { atan2($_[0], sqrt(1 - $_[0] * $_[0])) }
<1357>
eval {
local $SIG{ALARM} = sub { die "Alarm!\n" };
sleep;
};
die $@ unless $@ eq "Alarm!\n";
<1369> WRONG!!! WRONG!!!
use Socket;
socketpair(Rdr, Wtr, AF_UNIX, SOCK_STREAM, PF_UNSPEC);
shutdown(Rdr, 1); # no more writing for reader
shutdown(Wtr, 0); # no more reading for writer
<1383> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
# sort lexically
@articles = sort @files;
# same thing, but with explicit sort routine
@articles = sort {$a cmp $b} @files;
# now case-insensitively
@articles = sort {uc($a) cmp uc($b)} @files;
# same thing in reversed order
@articles = sort {$b cmp $a} @files;
# sort numerically ascending
@articles = sort {$a <=> $b} @files;
# sort numerically descending
@articles = sort {$b <=> $a} @files;
# this sorts the %age hash by value instead of key
# using an in-line function
@eldest = sort { $age{$b} <=> $age{$a} } keys %age;
# sort using explicit subroutine name
sub byage {
$age{$a} <=> $age{$b}; # presuming numeric
}
@sortedclass = sort byage @class;
sub backwards { $b cmp $a }
@harry = qw(dog cat x Cain Abel);
@george = qw(gone chased yz Punished Axed);
print sort @harry;
# prints AbelCaincatdogx
print sort backwards @harry;
# prints xdogcatCainAbel
print sort @george, 'to', @harry;
# prints AbelAxedCainPunishedcatchaseddoggonetoxyz
<1384>
# inefficiently sort by descending numeric compare using
# the first integer after the first = sign, or the
# whole record case-insensitively otherwise
<1385> WRONG!!!
my @new = sort {
($b =~ /=(\d+)/)[0] <=> ($a =~ /=(\d+)/)[0]
||
uc($a) cmp uc($b)
} @old;
<1386> WRONG!!! WRONG!!! WRONG!!!
# same thing, but much more efficiently;
# we'll build auxiliary indices instead
# for speed
my @nums = @caps = ();
for (@old) {
push @nums, ( /=(\d+)/ ? $1 : undef );
push @caps, uc($_);
}
<1387> WRONG!!! WRONG!!! WRONG!!!
my @new = @old[ sort {
$nums[$b] <=> $nums[$a]
||
$caps[$a] cmp $caps[$b]
} 0..$#old
];
<1388> WRONG!!! WRONG!!!
# same thing, but without any temps
@new = map { $_->[0] }
sort { $b->[1] <=> $a->[1]
||
$a->[2] cmp $b->[2]
} map { [$_, /=(\d+)/, uc($_)] } @old;
<1389> WRONG!!! WRONG!!!
# using a prototype allows you to use any comparison subroutine
# as a sort subroutine (including other package's subroutines)
package other;
sub backwards ($$) { $_[1] cmp $_[0]; } # $a and $b are not set here
package main;
@new = sort other::backwards @old;
# guarantee stability, regardless of algorithm
use sort 'stable';
@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
# force use of mergesort (not portable outside Perl 5.8)
use sort '_mergesort'; # note discouraging _
@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
<1391> WRONG!!! WRONG!!!
@contact = sort { $a cmp $b } find_records @key;
@contact = sort +find_records(@key);
@contact = sort &find_records(@key);
@contact = sort(find_records(@key));
<1393> WRONG!!! WRONG!!!
@contact = sort { find_records() } @key;
@contact = sort find_records(@key);
@contact = sort(find_records @key);
@contact = sort(find_records (@key));
<1395> WRONG!!! WRONG!!!
@articles = sort {$b <=> $a} @files;
<1397> WRONG!!! WRONG!!!
@articles = sort {$FooPack::b <=> $FooPack::a} @files;
<1400> WRONG!!! WRONG!!!
@result = sort { $a <=> $b } grep { $_ == $_ } @input;
<1408> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
push(@a,$x,$y) splice(@a,@a,0,$x,$y)
pop(@a) splice(@a,-1)
shift(@a) splice(@a,0,1)
unshift(@a,$x,$y) splice(@a,0,0,$x,$y)
$a[$i] = $y splice(@a,$i,1,$y)
<1410>
sub aeq { # compare two list values
my(@a) = splice(@_,0,shift);
my(@b) = splice(@_,0,shift);
return 0 unless @a == @b; # same len?
while (@a) {
return 0 if pop(@a) ne pop(@b);
}
return 1;
}
if (&aeq($len,@foo[1..$len],0+@bar,@bar)) { ... }
<1420>
print join(':', split(/ */, 'hi there')), "\n";
<1423>
print join(':', split(//, 'hi there')), "\n";
<1426>
print join(':', split(/(?=\w)/, 'hi there!'));
<1428>
print join(':', split(//, 'hi there!', -1)), "\n";
print join(':', split(/\W/, 'hi there!', -1)), "\n";
<1431> WRONG!!!
($login, $passwd, $remainder) = split(/:/, $_, 3);
<1434>
split(/([,-])/, "1-10,20", 3);
<1436>
(1, '-', 10, ',', 20)
<1438> WRONG!!! WRONG!!!
$header =~ s/\n(?=\s)//g; # fix continuation lines
%hdrs = (UNIX_FROM => split /^(\S*?):\s*/m, $header);
<1443> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
open(PASSWD, '/etc/passwd');
while (<PASSWD>) {
chomp;
($login, $passwd, $uid, $gid,
$gcos, $home, $shell) = split(/:/);
#...
}
<1445> WRONG!!!
@fields = split /(A)|B/, "1A2B3";
# @fields is (1, 'A', 2, undef, 3)
<1449> WRONG!!! WRONG!!!
# Format number with up to 8 leading zeroes
$result = sprintf("%08d", $number);
<1450> WRONG!!! WRONG!!!
# Round number to 3 digits after decimal point
$rounded = sprintf("%.3f", $number);
<1454>
%% a percent sign
%c a character with the given number
%s a string
%d a signed integer, in decimal
%u an unsigned integer, in decimal
%o an unsigned integer, in octal
%x an unsigned integer, in hexadecimal
%e a floating-point number, in scientific notation
%f a floating-point number, in fixed decimal notation
%g a floating-point number, in %e or %f notation
<1456>
%X like %x, but using upper-case letters
%E like %e, but using an upper-case "E"
%G like %g, but with an upper-case "E" (if applicable)
%b an unsigned integer, in binary
%B like %b, but using an upper-case "B" with the # flag
%p a pointer (outputs the Perl value's address in hexadecimal)
%n special: *stores* the number of characters output so far
into the next variable in the parameter list
<1458>
%i a synonym for %d
%D a synonym for %ld
%U a synonym for %lu
%O a synonym for %lo
%F a synonym for %f
<1464>
printf '%2$d %1$d', 12, 34; # prints "34 12"
printf '%3$d %d %1$d', 1, 2, 3; # prints "3 1 1"
<1467>
space prefix non-negative number with a space
+ prefix non-negative number with a plus sign
- left-justify within the field
0 use zeros, not spaces, to right-justify
# ensure the leading "0" for any octal,
prefix non-zero hexadecimal with "0x" or "0X",
prefix non-zero binary with "0b" or "0B"
<1469>
printf '<% d>', 12; # prints "< 12>"
printf '<%+d>', 12; # prints "<+12>"
printf '<%6s>', 12; # prints "< 12>"
printf '<%-6s>', 12; # prints "<12 >"
printf '<%06s>', 12; # prints "<000012>"
printf '<%#o>', 12; # prints "<014>"
printf '<%#x>', 12; # prints "<0xc>"
printf '<%#X>', 12; # prints "<0XC>"
printf '<%#b>', 12; # prints "<0b1100>"
printf '<%#B>', 12; # prints "<0B1100>"
<1471>
printf '<%+ d>', 12; # prints "<+12>"
printf '<% +d>', 12; # prints "<+12>"
<1473>
printf '<%#.5o>', 012; # prints "<00012>"
printf '<%#.5o>', 012345; # prints "<012345>"
printf '<%#.0o>', 0; # prints "<0>"
<1476>
printf "%vd", "AB\x{100}"; # prints "65.66.256"
printf "version is v%vd\n", $^V; # Perl's version
<1478> WRONG!!! WRONG!!!
printf "address is %*vX\n", ":", $addr; # IPv6 address
printf "bits are %0*v8b\n", " ", $bits; # random bitstring
<1480> WRONG!!!
printf '%*4$vX %*4$vX %*4$vX', @addr[1..3], ":"; # 3 IPv6 addresses
<1483>
printf '<%s>', "a"; # prints "<a>"
printf '<%6s>', "a"; # prints "< a>"
printf '<%*s>', 6, "a"; # prints "< a>"
printf '<%*2$s>', "a", 6; # prints "< a>"
printf '<%2s>', "long"; # prints "<long>" (does not truncate)
<1487>
# these examples are subject to system-specific variation
printf '<%f>', 1; # prints "<1.000000>"
printf '<%.1f>', 1; # prints "<1.0>"
printf '<%.0f>', 1; # prints "<1>"
printf '<%e>', 10; # prints "<1.000000e+01>"
printf '<%.1e>', 10; # prints "<1.0e+01>"
<1489>
# These examples are subject to system-specific variation.
printf '<%g>', 1; # prints "<1>"
printf '<%.10g>', 1; # prints "<1>"
printf '<%g>', 100; # prints "<100>"
printf '<%.1g>', 100; # prints "<1e+02>"
printf '<%.2g>', 100.01; # prints "<1e+02>"
printf '<%.5g>', 100.01; # prints "<100.01>"
printf '<%.4g>', 100.01; # prints "<100>"
<1491>
printf '<%.6d>', 1; # prints "<000001>"
printf '<%+.6d>', 1; # prints "<+000001>"
printf '<%-10.6d>', 1; # prints "<000001 >"
printf '<%10.6d>', 1; # prints "< 000001>"
printf '<%010.6d>', 1; # prints "< 000001>"
printf '<%+10.6d>', 1; # prints "< +000001>"
<1492>
printf '<%.6x>', 1; # prints "<000001>"
printf '<%#.6x>', 1; # prints "<0x000001>"
printf '<%-10.6x>', 1; # prints "<000001 >"
printf '<%10.6x>', 1; # prints "< 000001>"
printf '<%010.6x>', 1; # prints "< 000001>"
printf '<%#10.6x>', 1; # prints "< 0x000001>"
<1494>
printf '<%.5s>', "truncated"; # prints "<trunc>"
printf '<%10.5s>', "truncated"; # prints "< trunc>"
<1496>
printf '<%.6x>', 1; # prints "<000001>"
printf '<%.*x>', 6, 1; # prints "<000001>"
<1498>
printf '<%.*s>', 7, "string"; # prints "<string>"
printf '<%.*s>', 3, "string"; # prints "<str>"
printf '<%.*s>', 0, "string"; # prints "<>"
printf '<%.*s>', -1, "string"; # prints "<string>"
<1499>
printf '<%.*d>', 1, 0; # prints "<0>"
printf '<%.*d>', 0, 0; # prints "<>"
printf '<%.*d>', -1, 0; # prints "<0>"
<1501>
printf "<%.*2$x>", 1, 6; # INVALID, but in future will print "<000001>"
<1504>
l interpret integer as C type "long" or "unsigned long"
h interpret integer as C type "short" or "unsigned short"
q, L or ll interpret integer as C type "long long", "unsigned long long".
or "quads" (typically 64-bit integers)
<1506>
use Config;
if ($Config{use64bitint} eq "define" || $Config{longsize} >= 8) {
print "Nice quads!\n";
}
<1508>
use Config;
print "long doubles\n" if $Config{d_longdbl} eq "define";
<1510>
use Config;
if ($Config{uselongdouble} eq "define") {
print "long doubles by default\n";
}
<1512>
use Config;
($Config{doublesize} == $Config{longdblsize}) &&
print "doubles are long doubles\n";
<1517> WRONG!!! WRONG!!! WRONG!!!
printf "<%*.*s>", $a, $b, $c;
<1519> WRONG!!! WRONG!!!
printf "<%*1$.*s>", $a, $b;
<1522>
printf "%2\$d %d\n", 12, 34; # will print "34 12\n"
printf "%2\$d %d %d\n", 12, 34; # will print "34 12 34\n"
printf "%3\$d %d %d\n", 12, 34, 56; # will print "56 12 34\n"
printf "%2\$*3\$d %d\n", 12, 34, 3; # will print " 34 12\n"
<1528>
use Math::Complex;
print sqrt(-4); # prints 2i
<1539>
srand (time ^ $$ ^ unpack "%L*", `ps axww | gzip -f`);
<1542>
time ^ $$
<1544>
a^b == (a+1)^(b+1)
<1552> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks)
= stat($filename);
<1554>
0 dev device number of filesystem
1 ino inode number
2 mode file mode (type and permissions)
3 nlink number of (hard) links to the file
4 uid numeric user ID of file's owner
5 gid numeric group ID of file's owner
6 rdev the device identifier (special files only)
7 size total size of file, in bytes
8 atime last access time in seconds since the epoch
9 mtime last modify time in seconds since the epoch
10 ctime inode change time in seconds since the epoch (*)
11 blksize preferred block size for file system I/O
12 blocks actual number of blocks allocated
<1558> WRONG!!! WRONG!!!
if (-x $file && (($d) = stat(_)) && $d < 0) {
print "$file is executable NFS file\n";
}
<1561> WRONG!!! WRONG!!!
$mode = (stat($filename))[2];
printf "Permissions are %04o\n", $mode & 07777;
<1564> WRONG!!! WRONG!!!
use File::stat;
$sb = stat($filename);
printf "File is %s, size is %s, perm %04o, mtime %s\n",
$filename, $sb->size, $sb->mode & 07777,
scalar localtime $sb->mtime;
<1566>
use Fcntl ':mode';
<1567> WRONG!!! WRONG!!!
$mode = (stat($filename))[2];
<1568> WRONG!!! WRONG!!! WRONG!!! WRONG!!!
$user_rwx = ($mode & S_IRWXU) >> 6;
$group_read = ($mode & S_IRGRP) >> 3;
$other_execute = $mode & S_IXOTH;
<1569> WRONG!!!
printf "Permissions are %04o\n", S_IMODE($mode), "\n";
<1570> WRONG!!! WRONG!!!
$is_setuid = $mode & S_ISUID;
$is_directory = S_ISDIR($mode);
<1572>
# Permissions: read, write, execute, for user, group, others.
<1573>
S_IRWXU S_IRUSR S_IWUSR S_IXUSR
S_IRWXG S_IRGRP S_IWGRP S_IXGRP
S_IRWXO S_IROTH S_IWOTH S_IXOTH
<1574>
# Setuid/Setgid/Stickiness/SaveText.
# Note that the exact meaning of these is system dependent.
<1575>
S_ISUID S_ISGID S_ISVTX S_ISTXT
<1576>
# File types. Not necessarily all are available on your system.
<1577>
S_IFREG S_IFDIR S_IFLNK S_IFBLK S_IFCHR S_IFIFO S_IFSOCK S_IFWHT S_ENFMT
<1578>
# The following are compatibility aliases for S_IRUSR, S_IWUSR, S_IXUSR.
<1579>
S_IREAD S_IWRITE S_IEXEC
<1581> WRONG!!!
S_IMODE($mode) the part of $mode containing the permission bits
and the setuid/setgid/sticky bits
<1582> WRONG!!!
S_IFMT($mode) the part of $mode containing the file type
which can be bit-anded with (for example) S_IFREG
or with the following functions
<1583>
# The operators -f, -d, -l, -b, -c, -p, and -S.
<1584> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
S_ISREG($mode) S_ISDIR($mode) S_ISLNK($mode)
S_ISBLK($mode) S_ISCHR($mode) S_ISFIFO($mode) S_ISSOCK($mode)
<1585>
# No direct -X operator counterpart, but for the first one
# the -g operator is often equivalent. The ENFMT stands for
# record flocking enforcement, a platform-dependent feature.
<1586> WRONG!!! WRONG!!!
S_ISENFMT($mode) S_ISWHT($mode)
<1598>
while (<>) {
study;
print ".IX foo\n" if /\bfoo\b/;
print ".IX bar\n" if /\bbar\b/;
print ".IX blurfl\n" if /\bblurfl\b/;
# ...
print;
}
<1601> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
$search = 'while (<>) { study;';
foreach $word (@words) {
$search .= "++\$seen{\$ARGV} if /\\b$word\\b/;\n";
}
$search .= "}";
@ARGV = @files;
undef $/;
eval $search; # this screams
$/ = "\n"; # put back to normal input delimiter
foreach $file (sort keys(%seen)) {
print $file, "\n";
}
<1612>
my $s = "The black cat climbed the green tree";
my $color = substr $s, 4, 5; # black
my $middle = substr $s, 4, -11; # black cat climbed the
my $end = substr $s, 14; # climbed the green tree
my $tail = substr $s, -4; # tree
my $z = substr $s, -4, 2; # tr
<1615>
my $name = 'fred';
substr($name, 4) = 'dy'; # $name is now 'freddy'
my $null = substr $name, 6, 2; # returns "" (no warning)
my $oops = substr $name, 7; # returns undef, with warning
substr($name, 7) = 'gap'; # raises an exception
<1617>
my $s = "The black cat climbed the green tree";
my $z = substr $s, 14, 7, "jumped from"; # climbed
# $s is now "The black cat jumped from the green tree"
<1619> WRONG!!!
$x = '1234';
for (substr($x,1,2)) {
$_ = 'a'; print $x,"\n"; # prints 1a4
$_ = 'xyz'; print $x,"\n"; # prints 1xyz4
$x = '56789';
$_ = 'pq'; print $x,"\n"; # prints 5pq9
}
<1623> WRONG!!!
$symlink_exists = eval { symlink("",""); 1 };
<1626> WRONG!!!
require 'syscall.ph'; # may need to run h2ph
$s = "hi there\n";
syscall(&SYS_write, fileno(STDOUT), $s, length $s);
<1653>
use Fcntl 'SEEK_CUR';
sub systell { sysseek($_[0], 0, SEEK_CUR) }
<1663> WRONG!!!
@args = ("command", "arg1", "arg2");
system(@args) == 0
or die "system @args failed: $?"
<1665>
if ($? == -1) {
print "failed to execute: $!\n";
}
elsif ($? & 127) {
printf "child died with signal %d, %s coredump\n",
($? & 127), ($? & 128) ? 'with' : 'without';
}
else {
printf "child exited with value %d\n", $? >> 8;
}
<1687> WRONG!!! WRONG!!! WRONG!!!
# print out history file offsets
use NDBM_File;
tie(%HIST, 'NDBM_File', '/usr/lib/news/history', 1, 0);
while (($key,$val) = each %HIST) {
print $key, ' = ', unpack('L',$val), "\n";
}
untie(%HIST);
<1689>
TIEHASH classname, LIST
FETCH this, key
STORE this, key, value
DELETE this, key
CLEAR this
EXISTS this, key
FIRSTKEY this
NEXTKEY this, lastkey
SCALAR this
DESTROY this
UNTIE this
<1691>
TIEARRAY classname, LIST
FETCH this, key
STORE this, key, value
FETCHSIZE this
STORESIZE this, count
CLEAR this
PUSH this, LIST
POP this
SHIFT this
UNSHIFT this, LIST
SPLICE this, offset, length, LIST
EXTEND this, count
DESTROY this
UNTIE this
<1693>
TIEHANDLE classname, LIST
READ this, scalar, length, offset
READLINE this
GETC this
WRITE this, scalar, length, offset
PRINT this, LIST
PRINTF this, format, LIST
BINMODE this
EOF this
FILENO this
SEEK this, position, whence
TELL this
OPEN this, mode, LIST
CLOSE this
DESTROY this
UNTIE this
<1695>
TIESCALAR classname, LIST
FETCH this,
STORE this, value
DESTROY this
UNTIE this
<1707> WRONG!!! WRONG!!! WRONG!!! WRONG!!!
($user,$system,$cuser,$csystem) = times;
<1737> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
undef $foo;
undef $bar{'blurfl'}; # Compare to: delete $bar{'blurfl'};
undef @ary;
undef %hash;
undef &mysub;
undef *xyz; # destroys $xyz, @xyz, %xyz, &xyz, etc.
return (wantarray ? (undef, $errmsg) : undef) if $they_blew_it;
select undef, undef, undef, 0.25;
($a, $b, undef, $c) = &foo; # Ignore third value returned
<1742> WRONG!!!
my $unlinked = unlink 'a', 'b', 'c';
unlink @goners;
unlink glob "*.bak";
<1744> WRONG!!! WRONG!!!
foreach my $file ( @goners ) {
unlink $file or warn "Could not unlink $file: $!";
}
<1753>
sub substr {
my($what,$where,$howmuch) = @_;
unpack("x$where a$howmuch", $what);
}
<1755>
sub ordinal { unpack("W",$_[0]); } # same as ord()
<1758> WRONG!!!
$checksum = do {
local $/; # slurp!
unpack("%32W*",<>) % 65535;
};
<1760> WRONG!!! WRONG!!!
$setbits = unpack("%32b*", $selectmask);
<1768>
unshift(@ARGV, '-e') unless $ARGV[0] =~ /^-/;
<1777>
BEGIN { require Module; Module->import( LIST ); }
<1781>
use v5.6.1; # compile time version check
use 5.6.1; # ditto
use 5.006_001; # ditto; preferred for backwards compatibility
<1786>
use Module ();
<1788>
BEGIN { require Module }
<1792>
use constant;
use diagnostics;
use integer;
use sigtrap qw(SEGV BUS);
use strict qw(subs vars refs);
use subs qw(afunc blurfl);
use warnings qw(all);
use sort qw(stable _quicksort _mergesort);
<1795>
use if $] < 5.008, "utf8";
use if WANT_WARNINGS, warnings => qw(all);
<1797>
no integer;
no strict 'refs';
no warnings;
<1802> WRONG!!! WRONG!!! WRONG!!!
#!/usr/bin/perl
$atime = $mtime = time;
utime $atime, $mtime, @ARGV;
<1804> WRONG!!!
for $file (@ARGV) {
utime(undef, undef, $file)
|| warn "couldn't touch $file: $!";
}
<1814> WRONG!!! WRONG!!!
for (values %hash) { s/foo/bar/g } # modifies %hash values
for (@hash{keys %hash}) { s/foo/bar/g } # same
<1816> WRONG!!! WRONG!!!
for (values $hashref) { ... }
for (values $obj->get_arrayref) { ... }
<1825> WRONG!!! WRONG!!! WRONG!!! WRONG!!!
vec($image, $max_x * $x + $y, 8) = 3;
<1830>
my $foo = '';
vec($foo, 0, 32) = 0x5065726C; # 'Perl'
<1831>
# $foo eq "Perl" eq "\x50\x65\x72\x6C", 32 bits
print vec($foo, 0, 8); # prints 80 == 0x50 == ord('P')
<1832>
vec($foo, 2, 16) = 0x5065; # 'PerlPe'
vec($foo, 3, 16) = 0x726C; # 'PerlPerl'
vec($foo, 8, 8) = 0x50; # 'PerlPerlP'
vec($foo, 9, 8) = 0x65; # 'PerlPerlPe'
vec($foo, 20, 4) = 2; # 'PerlPerlPe' . "\x02"
vec($foo, 21, 4) = 7; # 'PerlPerlPer'
# 'r' is "\x72"
vec($foo, 45, 2) = 3; # 'PerlPerlPer' . "\x0c"
vec($foo, 93, 1) = 1; # 'PerlPerlPer' . "\x2c"
vec($foo, 94, 1) = 1; # 'PerlPerlPerl'
# 'l' is "\x6c"
<1834> WRONG!!! WRONG!!! WRONG!!!
$bits = unpack("b*", $vector);
@bits = split(//, unpack("b*", $vector));
<1837>
#!/usr/bin/perl -wl
<1838>
print <<'EOT';
0 1 2 3
unpack("V",$_) 01234567890123456789012345678901
------------------------------------------------------------------
EOT
<1839> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
for $w (0..3) {
$width = 2**$w;
for ($shift=0; $shift < $width; ++$shift) {
for ($off=0; $off < 32/$width; ++$off) {
$str = pack("B*", "0"x32);
$bits = (1<<$shift);
vec($str, $off, $width) = $bits;
$res = unpack("b*",$str);
$val = unpack("V", $str);
write;
}
}
}
<1840> WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!! WRONG!!!
format STDOUT =
vec($_,@#,@#) = @<< == @######### @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
$off, $width, $bits, $val, $res
.
__END__
<1842>
0 1 2 3
unpack("V",$_) 01234567890123456789012345678901
------------------------------------------------------------------
vec($_, 0, 1) = 1 == 1 10000000000000000000000000000000
vec($_, 1, 1) = 1 == 2 01000000000000000000000000000000
vec($_, 2, 1) = 1 == 4 00100000000000000000000000000000
vec($_, 3, 1) = 1 == 8 00010000000000000000000000000000
vec($_, 4, 1) = 1 == 16 00001000000000000000000000000000
vec($_, 5, 1) = 1 == 32 00000100000000000000000000000000
vec($_, 6, 1) = 1 == 64 00000010000000000000000000000000
vec($_, 7, 1) = 1 == 128 00000001000000000000000000000000
vec($_, 8, 1) = 1 == 256 00000000100000000000000000000000
vec($_, 9, 1) = 1 == 512 00000000010000000000000000000000
vec($_,10, 1) = 1 == 1024 00000000001000000000000000000000
vec($_,11, 1) = 1 == 2048 00000000000100000000000000000000
vec($_,12, 1) = 1 == 4096 00000000000010000000000000000000
vec($_,13, 1) = 1 == 8192 00000000000001000000000000000000
vec($_,14, 1) = 1 == 16384 00000000000000100000000000000000
vec($_,15, 1) = 1 == 32768 00000000000000010000000000000000
vec($_,16, 1) = 1 == 65536 00000000000000001000000000000000
vec($_,17, 1) = 1 == 131072 00000000000000000100000000000000
vec($_,18, 1) = 1 == 262144 00000000000000000010000000000000
vec($_,19, 1) = 1 == 524288 00000000000000000001000000000000
vec($_,20, 1) = 1 == 1048576 00000000000000000000100000000000
vec($_,21, 1) = 1 == 2097152 00000000000000000000010000000000
vec($_,22, 1) = 1 == 4194304 00000000000000000000001000000000
vec($_,23, 1) = 1 == 8388608 00000000000000000000000100000000
vec($_,24, 1) = 1 == 16777216 00000000000000000000000010000000
vec($_,25, 1) = 1 == 33554432 00000000000000000000000001000000
vec($_,26, 1) = 1 == 67108864 00000000000000000000000000100000
vec($_,27, 1) = 1 == 134217728 00000000000000000000000000010000
vec($_,28, 1) = 1 == 268435456 00000000000000000000000000001000
vec($_,29, 1) = 1 == 536870912 00000000000000000000000000000100
vec($_,30, 1) = 1 == 1073741824 00000000000000000000000000000010
vec($_,31, 1) = 1 == 2147483648 00000000000000000000000000000001
vec($_, 0, 2) = 1 == 1 10000000000000000000000000000000
vec($_, 1, 2) = 1 == 4 00100000000000000000000000000000
vec($_, 2, 2) = 1 == 16 00001000000000000000000000000000
vec($_, 3, 2) = 1 == 64 00000010000000000000000000000000
vec($_, 4, 2) = 1 == 256 00000000100000000000000000000000
vec($_, 5, 2) = 1 == 1024 00000000001000000000000000000000
vec($_, 6, 2) = 1 == 4096 00000000000010000000000000000000
vec($_, 7, 2) = 1 == 16384 00000000000000100000000000000000
vec($_, 8, 2) = 1 == 65536 00000000000000001000000000000000
vec($_, 9, 2) = 1 == 262144 00000000000000000010000000000000
vec($_,10, 2) = 1 == 1048576 00000000000000000000100000000000
vec($_,11, 2) = 1 == 4194304 00000000000000000000001000000000
vec($_,12, 2) = 1 == 16777216 00000000000000000000000010000000
vec($_,13, 2) = 1 == 67108864 00000000000000000000000000100000
vec($_,14, 2) = 1 == 268435456 00000000000000000000000000001000
vec($_,15, 2) = 1 == 1073741824 00000000000000000000000000000010
vec($_, 0, 2) = 2 == 2 01000000000000000000000000000000
vec($_, 1, 2) = 2 == 8 00010000000000000000000000000000
vec($_, 2, 2) = 2 == 32 00000100000000000000000000000000
vec($_, 3, 2) = 2 == 128 00000001000000000000000000000000
vec($_, 4, 2) = 2 == 512 00000000010000000000000000000000
vec($_, 5, 2) = 2 == 2048 00000000000100000000000000000000
vec($_, 6, 2) = 2 == 8192 00000000000001000000000000000000
vec($_, 7, 2) = 2 == 32768 00000000000000010000000000000000
vec($_, 8, 2) = 2 == 131072 00000000000000000100000000000000
vec($_, 9, 2) = 2 == 524288 00000000000000000001000000000000
vec($_,10, 2) = 2 == 2097152 00000000000000000000010000000000
vec($_,11, 2) = 2 == 8388608 00000000000000000000000100000000
vec($_,12, 2) = 2 == 33554432 00000000000000000000000001000000
vec($_,13, 2) = 2 == 134217728 00000000000000000000000000010000
vec($_,14, 2) = 2 == 536870912 00000000000000000000000000000100
vec($_,15, 2) = 2 == 2147483648 00000000000000000000000000000001
vec($_, 0, 4) = 1 == 1 10000000000000000000000000000000
vec($_, 1, 4) = 1 == 16 00001000000000000000000000000000
vec($_, 2, 4) = 1 == 256 00000000100000000000000000000000
vec($_, 3, 4) = 1 == 4096 00000000000010000000000000000000
vec($_, 4, 4) = 1 == 65536 00000000000000001000000000000000
vec($_, 5, 4) = 1 == 1048576 00000000000000000000100000000000
vec($_, 6, 4) = 1 == 16777216 00000000000000000000000010000000
vec($_, 7, 4) = 1 == 268435456 00000000000000000000000000001000
vec($_, 0, 4) = 2 == 2 01000000000000000000000000000000
vec($_, 1, 4) = 2 == 32 00000100000000000000000000000000
vec($_, 2, 4) = 2 == 512 00000000010000000000000000000000
vec($_, 3, 4) = 2 == 8192 00000000000001000000000000000000
vec($_, 4, 4) = 2 == 131072 00000000000000000100000000000000
vec($_, 5, 4) = 2 == 2097152 00000000000000000000010000000000
vec($_, 6, 4) = 2 == 33554432 00000000000000000000000001000000
vec($_, 7, 4) = 2 == 536870912 00000000000000000000000000000100
vec($_, 0, 4) = 4 == 4 00100000000000000000000000000000
vec($_, 1, 4) = 4 == 64 00000010000000000000000000000000
vec($_, 2, 4) = 4 == 1024 00000000001000000000000000000000
vec($_, 3, 4) = 4 == 16384 00000000000000100000000000000000
vec($_, 4, 4) = 4 == 262144 00000000000000000010000000000000
vec($_, 5, 4) = 4 == 4194304 00000000000000000000001000000000
vec($_, 6, 4) = 4 == 67108864 00000000000000000000000000100000
vec($_, 7, 4) = 4 == 1073741824 00000000000000000000000000000010
vec($_, 0, 4) = 8 == 8 00010000000000000000000000000000
vec($_, 1, 4) = 8 == 128 00000001000000000000000000000000
vec($_, 2, 4) = 8 == 2048 00000000000100000000000000000000
vec($_, 3, 4) = 8 == 32768 00000000000000010000000000000000
vec($_, 4, 4) = 8 == 524288 00000000000000000001000000000000
vec($_, 5, 4) = 8 == 8388608 00000000000000000000000100000000
vec($_, 6, 4) = 8 == 134217728 00000000000000000000000000010000
vec($_, 7, 4) = 8 == 2147483648 00000000000000000000000000000001
vec($_, 0, 8) = 1 == 1 10000000000000000000000000000000
vec($_, 1, 8) = 1 == 256 00000000100000000000000000000000
vec($_, 2, 8) = 1 == 65536 00000000000000001000000000000000
vec($_, 3, 8) = 1 == 16777216 00000000000000000000000010000000
vec($_, 0, 8) = 2 == 2 01000000000000000000000000000000
vec($_, 1, 8) = 2 == 512 00000000010000000000000000000000
vec($_, 2, 8) = 2 == 131072 00000000000000000100000000000000
vec($_, 3, 8) = 2 == 33554432 00000000000000000000000001000000
vec($_, 0, 8) = 4 == 4 00100000000000000000000000000000
vec($_, 1, 8) = 4 == 1024 00000000001000000000000000000000
vec($_, 2, 8) = 4 == 262144 00000000000000000010000000000000
vec($_, 3, 8) = 4 == 67108864 00000000000000000000000000100000
vec($_, 0, 8) = 8 == 8 00010000000000000000000000000000
vec($_, 1, 8) = 8 == 2048 00000000000100000000000000000000
vec($_, 2, 8) = 8 == 524288 00000000000000000001000000000000
vec($_, 3, 8) = 8 == 134217728 00000000000000000000000000010000
vec($_, 0, 8) = 16 == 16 00001000000000000000000000000000
vec($_, 1, 8) = 16 == 4096 00000000000010000000000000000000
vec($_, 2, 8) = 16 == 1048576 00000000000000000000100000000000
vec($_, 3, 8) = 16 == 268435456 00000000000000000000000000001000
vec($_, 0, 8) = 32 == 32 00000100000000000000000000000000
vec($_, 1, 8) = 32 == 8192 00000000000001000000000000000000
vec($_, 2, 8) = 32 == 2097152 00000000000000000000010000000000
vec($_, 3, 8) = 32 == 536870912 00000000000000000000000000000100
vec($_, 0, 8) = 64 == 64 00000010000000000000000000000000
vec($_, 1, 8) = 64 == 16384 00000000000000100000000000000000
vec($_, 2, 8) = 64 == 4194304 00000000000000000000001000000000
vec($_, 3, 8) = 64 == 1073741824 00000000000000000000000000000010
vec($_, 0, 8) = 128 == 128 00000001000000000000000000000000
vec($_, 1, 8) = 128 == 32768 00000000000000010000000000000000
vec($_, 2, 8) = 128 == 8388608 00000000000000000000000100000000
vec($_, 3, 8) = 128 == 2147483648 00000000000000000000000000000001
<1848> WRONG!!!
use POSIX ":sys_wait_h";
#...
do {
$kid = waitpid(-1, WNOHANG);
} while $kid > 0;
<1853> WRONG!!!
return unless defined wantarray; # don't bother doing more
my @a = complex_calculation();
return wantarray ? @a : "@a";
<1863>
# wipe out *all* compile-time warnings
BEGIN { $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN } }
my $foo = 10;
my $foo = 20; # no warning about duplicate my $foo,
# but hey, you asked for it!
# no compile-time or run-time warnings before here
$DOWARN = 1;
<1864> WRONG!!!
# run-time warnings enabled after here
warn "\$foo is alive and $foo!"; # does show up