print 1+2+3;       # Prints 6.
print(1+2) + 3;    # Prints 3.
print (1+2)+3;     # Also prints 3!
print +(1+2)+3;    # Prints 6.
print ((1+2)+3);   # Prints 6.
*****
unshift @array,0644;
chmod @array;
*****
chmod 0644, @array;
*****
unless ($peer = accept NS, S) {
    die "Can't accept a connection: $!\n";
}
*****
$pi = atan2(1,1) * 4;
*****
sub tan { sin($_[0]) / cos($_[0])  }
*****
bind S, $sockaddr or die "Can't bind address: $!\n";
*****
open WP, "$file.wp" or die "Can't open $file.wp: $!\n";
binmode WP;
while (read WP, $buf, 1024) {...}
*****
($package, $filename, $line) = caller;
*****
$i = 0;
while (($pack, $file, $line, $subname, $hasargs, $wantarray)
  = caller($i++)) {
    ...
}
*****
chdir "$prefix/lib" or die "Can't cd to $prefix/lib: $!\n";
*****
$ok = chdir($ENV{"HOME"} || $ENV{"LOGDIR"} || (getpwuid($<))[7]);
*****
$ok = chdir() || chdir((getpwuid($<))[7]);
*****
$cnt = chmod 0755, 'file1', 'file2';
*****
chmod 0755, @executables;
*****
@cannot = grep {not chmod 0755, $_} 'file1', 'file2', 'file3';
die "$0: could not chmod @cannot\n" if @cannot;
*****
while (<PASSWD>) {
    chop;   # avoid \n on last field
    @array = split /:/;
    ...
}
*****
@lines = `cat myfile`;
chop @lines;
*****
chop($cwd = `pwd`);
chop($answer = <STDIN>);
*****
$answer = chop($tmp = <STDIN>);  # WRONG
*****
$answer = substr <STDIN>, 0, -1;
*****
chop($answer = <STDIN>);
*****
substr($caravan, -5) = '';
*****
$cnt = chown $uid, $gid, 'file1', 'file2';
*****
chown $uid, $gid, @filenames;
*****
sub chown_by_name {
    local($user, $pattern) = @_;
    chown((getpwnam($user))[2,3], glob($pattern));
}

&chown_by_name("fred", "*.c");
*****
chroot +(getpwnam('ftp'))[7]
    or die "Can't do anonymous ftp: $!\n";
*****
open OUTPUT, '|sort >foo';     # pipe to sort
...                            # print stuff to output
close OUTPUT;                  # wait for sort to finish
die "sort failed" if $?;       # check for sordid sort
open INPUT, 'foo';             # get sort's results
*****
connect S, $destadd
    or die "Can't connect to $hostname: $!\n";
*****
dbmopen %ALIASES, "/etc/aliases", 0666
    or die "Can't open aliases: $!\n";

while (($key,$val) = each %ALIASES) {
    print $key, ' = ', $val, "\n";
}
dbmclose %ALIASES;
*****
print if defined $switch{'D'};
*****
print "$val\n" while defined($val = pop(@ary));
*****
die "Can't readlink $sym: $!"
    unless defined($value = readlink $sym);
*****
die "No XYZ package defined" unless defined %XYZ::;
*****
sub saymaybe {
   if (defined &say) {
       say(@_);
   }
   else {
       warn "Can't say";
   }
}
*****
foreach $key (keys %ARRAY) {
    delete $ARRAY{$key};
}
*****
delete $ref->[$x][$y]{$key};
*****
die "Can't cd to spool: $!\n" unless chdir '/usr/spool/news';

chdir '/usr/spool/news' or die "Can't cd to spool: $!\n" 
*****
die "/etc/games is no good";
die "/etc/games is no good, stopped";
*****
/etc/games is no good at canasta line 123.
/etc/games is no good, stopped at canasta line 123.
*****
die '"', __FILE__, '", line ', __LINE__, ", phooey on you!\n";
*****
do 'stat.pl';
*****
eval `cat stat.pl`;
*****
#!/usr/bin/perl
use Getopt::Std;
use MyHorridModule;
%days = (
    Sun => 1,
    Mon => 2,
    Tue => 3,
    Wed => 4,
    Thu => 5,
    Fri => 6,
    Sat => 7,
);

dump QUICKSTART if $ARGV[0] eq '-d';

QUICKSTART:
Getopts('f:');
...
*****
while (($key,$value) = each %ENV) {
    print "$key=$value\n";
}
*****
while (<>) {
    if (eof()) {
        print "-" x 30, "\n";
    }
    print;
}
*****
while (<>) {
    print "$.\t$_";
    if (eof) {       # Not eof().
        close ARGV;  # reset $.
    }
}
*****
while (<>) {
    print if /pattern/ .. eof;
}
*****
exec 'echo', 'Your arguments are: ', @ARGV;
*****
exec "sort $outfile | uniq"
  or die "Can't do sort/uniq: $!\n";
*****
$shell = '/bin/csh';
exec $shell '-sh', @args;      # pretend it's a login shell
die "Couldn't execute csh: $!\n";
*****
exec {'/bin/csh'} '-sh', @args; # pretend it's a login shell
*****
print "Exists\n" if exists $hash{$key};
print "Defined\n" if defined $hash{$key};
print "True\n" if $hash{$key};
*****
if (exists $ref->[$x][$y]{$key}) { ... }
*****
$ans = <STDIN>;
exit 0 if $ans =~ /^[Xx]/;
*****
use Fcntl;
$retval = fcntl(...) or $retval = -1;
printf "System returned %d\n", $retval;
*****
use Fcntl;
open TTY,"+>/dev/tty" or die "Can't open /dev/tty: $!\n";
fileno TTY == 3 or die "Internal error: fd mixup";
fcntl TTY, &F_SETFL, 0
    or die "Can't clear the close-on-exec flag: $!\n";
*****
format NAME =
    picture line
    value list
    ...
\s+2.\s0
*****
my $str = "widget";               # A lexically scoped variable.

format Nice_Output =
Test: @<<<<<<<< @||||| @>>>>>
      $str,     $%,    '$' . int($num)
\s+2.\s0

$~ = "Nice_Output";               # Select our format.
local $num = $cost * $quantity;   # Dynamically scoped variable.

write;
*****
while (($name, $passwd, $gid) = getgrent) {
    $gid{$name} = $gid;
}
*****
($a, $b, $c, $d) = unpack('C4', $addrs[0]);
*****
$login = getlogin || (getpwuid($<))[0] || "Intruder!!";
*****
use Socket;
$hersockaddr = getpeername SOCK;
($port, $heraddr) = unpack_sockaddr_in($hersockaddr);
$herhostname = gethostbyaddr($heraddr, AF_INET);
$herstraddr = inet_ntoa($heraddr);
*****
$curprio = getpriority(0, 0);
*****
while (($name, $passwd, $uid) = getpwent) {
    $uid{$name} = $uid;
}
*****
use Socket;
$mysockaddr = getsockname(SOCK);
($port, $myaddr) = unpack_sockaddr_in($mysockaddr);
*****
@result = map { glob($_) } "*.c", "*.c,v";

@result = map <${_}>, "*.c", "*.c,v";
*****
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
        gmtime(time);
*****
$london_month = (qw(Jan Feb Mar Apr May Jun
        Jul Aug Sep Oct Nov Dec))[(gmtime)[4]];
*****
goto +("FOO", "BAR", "GLARCH")[$i];
*****
@code_lines = grep !/^#/, @all_lines;
*****
@list = qw(barney fred dino wilma);
@greplist = grep { s/^[bfd]// } @list;
*****
@out = grep { EXPR } @in;
@out = map { EXPR ? $_ : () } @in
*****
$number = hex("ffff12c0");
*****
sprintf "%lx", $number;         # (That's an ell, not a one.)
*****
$pos = -1;
while (($pos = index($string, $lookfor, $pos)) > -1) {
    print "Found at $pos\n";
    $pos++;
}
*****
$average_age = 939/16;      # yields 58.6875 (58 in C)
$average_age = int 939/16;  # yields 58
*****
$retval = ioctl(...) or $retval = -1;
printf "System returned %d\n", $retval;
*****
system "stty -echo";   # Works on most UNIX boxen.
*****
$_ = join ':', $login,$passwd,$uid,$gid,$gcos,$home,$shell;
*****
@keys = keys %ENV;
@values = values %ENV;
while (@keys) {
    print pop(@keys), '=', pop(@values), "\n";
}
*****
foreach $key (sort keys %ENV) {
    print $key, '=', $ENV{$key}, "\n";
}
*****
foreach $key (sort { $hash{$b} <=> $hash{$a} } keys %hash)) {
    printf "%4d %s\n", $hash{$key}, $key;
}
*****
$cnt = kill 1, $child1, $child2;
kill 9, @goners;
kill 'STOP', getppid;  # Can *so* suspend my login shell...
*****
LINE: while (<STDIN>) {
    last LINE if /^$/; # exit when done with header
    # rest of loop here
}
*****
&RANGEVAL(20, 30, '$foo[$i] = $i');

sub RANGEVAL {
    local($min, $max, $thunk) = @_;
    local $result = '';
    local $i;

    # Presumably $thunk makes reference to $i

    for ($i = $min; $i < $max; $i++) {
        $result .= eval $thunk;
    }

    $result;
}
*****
if ($sw eq '-v') {
    # init local array with global array
    local @ARGV = @ARGV;
    unshift @ARGV, 'echo';
    system @ARGV;
}
# @ARGV restored
*****
# temporarily add a couple of entries to the %digits hash
if ($base12) {
    # (NOTE: not claiming this is efficient!)
    local(%digits) = (%digits, T => 10, E => 11);
    parse_num();
}
*****
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
        localtime(time);
*****
$thisday = (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[(localtime)[6]];
*****
perl -e 'print scalar localtime'
*****
@words = map { split ' ' } @lines;
*****
@chars = map chr, @nums;
*****
%hash = map { genkey($_), $_ } @array;
*****
%hash = ();
foreach $_ (@array) {
    $hash{genkey($_)} = $_;
}
*****
require "ipc.ph";
require "msg.ph";
$msg = pack "L a*", $type, $text_of_message;
*****
my ($friends, $romans, $countrymen) = @_;
*****
my $country = @_;  # right or wrong?
*****
sub simple_as {
    my $self = shift;   # scalar assignment
    my ($a,$b,$c) = @_; # list assignment
    ...
}
*****
LINE: while (<STDIN>) {
    next LINE if /^#/;     # discard comments
    ...
}
*****
$val = oct $val if $val =~ /^0/;
*****
$oct_string = sprintf "%lo", $number;
*****
$ARTICLE = "/usr/spool/news/comp/lang/perl/misc/38245";
open ARTICLE or die "Can't find article $ARTICLE: $!\n";
while (<ARTICLE>) {...
*****
open LOG, '>>/usr/spool/news/twitlog'; # (`log' is reserved)
*****
open ARTICLE, "caesar <$article |";   # decrypt article with rot13
*****
open EXTRACT, "|sort >/tmp/Tmp$$";    # $$ is our process#
*****
# Process argument list of files along with any includes.

foreach $file (@ARGV) {
    process($file, 'fh00');
}

sub process {
    local($filename, $input) = @_;
    $input++;               # this is a string increment
    unless (open $input, $filename) {
        print STDERR "Can't open $filename: $!\n";
        return;
    }
    while (<$input>) {      # note the use of indirection
        if (/^#include "(.*)"/) {
            process($1, $input);
            next;
        }
        ...               # whatever
    }
    close $input;
}
*****
#!/usr/bin/perl
open SAVEOUT, ">&STDOUT";
open SAVEERR, ">&STDERR";

open STDOUT, ">foo.out" or die "Can't redirect stdout";
open STDERR, ">&STDOUT" or die "Can't dup stdout";

select STDERR; $| = 1;         # make unbuffered
select STDOUT; $| = 1;         # make unbuffered

print STDOUT "stdout 1\n";      # this works for
print STDERR "stderr 1\n";      # subprocesses too

close STDOUT;
close STDERR;

open STDOUT, ">&SAVEOUT";
open STDERR, ">&SAVEERR";

print STDOUT "stdout 2\n";
print STDERR "stderr 2\n";
*****
open FILEHANDLE, "<&=$fd";
*****
open FOO, "|tr '[a-z]' '[A-Z]'";
open FOO, "|-" or exec 'tr', '[a-z]', '[A-Z]';

open FOO, "cat -n file|";
open FOO, "-|" or exec 'cat', '-n', 'file';
*****
use FileHandle;
...
sub read_myfile_munged {
    my $ALL = shift;
    my $handle = new FileHandle;
    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.
}
*****
$file =~ s#^\s#./$&#;
open FOO, "< $file\0";
*****
use FileHandle;
sysopen HANDLE, $path, O_RDWR|O_CREAT|O_EXCL, 0700
    or die "sysopen $path: $!";
HANDLE->autoflush(1);
HANDLE->print("stuff $$\n");
seek HANDLE, 0, 0;
print "File contains: ", <HANDLE>;
*****
$out = pack "cccc", 65, 66, 67, 68;      # $out eq "ABCD"
$out = pack "c4", 65, 66, 67, 68;        # same thing
*****
$out = pack "ccxxcc", 65, 66, 67, 68;    # $out eq "AB\0\0CD"
*****
$out = pack "s2", 1, 2;    # "\1\0\2\0" on little-endian
                           # "\0\1\0\2" on big-endian
*****
$out = pack "B32", "01010000011001010111001001101100";
$out = pack "H8", "5065726c";    # both produce "Perl"
*****
$out = pack "a4", "abcd", "x", "y", "z";      # "abcd"
*****
$out = pack "aaaa",  "abcd", "x", "y", "z";   # "axyz"
$out = pack "a" x 4, "abcd", "x", "y", "z";   # "axyz"
*****
$out = pack "a14", "abcdefg";   # "abcdefg\0\0\0\0\0\0\0"
*****
$out = pack "i9pl", gmtime, $tz, $toff;
*****
$tmp = $ARRAY[$#ARRAY--];
*****
$tmp = splice @ARRAY, -1;
*****
(something_returning_a_list)[-1]
*****
$grafitto = "fee fie foe foo";
while ($grafitto =~ m/e/g) {
    print pos $grafitto, "\n";
}
*****
$grafitto = "fee fie foe foo";
pos $grafitto = 4;  # Skip the fee, start at fie
while ($grafitto =~ m/e/g) {
	print pos $grafitto, "\n";
}
*****
print { $OK ? "STDOUT" : "STDERR" } "stuff\n";
print { $iohandle[$i] } "stuff\n";
*****
print $a - 2; # prints $a - 2 to default filehandle (usually STDOUT)
print $a (- 2); # prints -2 to filehandle specified in $a
print $a -2; # ditto (weird parsing rules :-)
*****
print OUT <STDIN>;
*****
print (1+2)*3, "\n";            # wrong
print +(1+2)*3, "\n";           # ok
print ((1+2)*3, "\n");          # ok
*****
foreach $value (LIST) {
    $ARRAY[++$#ARRAY] = $value;
}
*****
splice @ARRAY, @ARRAY, 0, LIST;
*****
for (;;) {
    push @ARRAY, shift @ARRAY;
    ...
}
*****
$roll = int(rand 6) + 1;       # $roll is now an integer
                               # between 1 and 6
*****
while (read FROM, $buf, 16384) {
    print TO $buf;
}
*****
opendir THISDIR, "." or die "serious dainbramage: $!";
@allfiles = readdir THISDIR;
closedir THISDIR;
print "@allfiles\n";
*****
@allfiles = grep !/^\.\.?$/, readdir THISDIR;
*****
@allfiles = grep !/^\./, readdir THISDIR;
*****
@textfiles = grep -T, readdir THISDIR;
*****
opendir THATDIR, $thatdir;
@text_of_thatdir = grep -T, map "$thatdir/$_", readdir THATDIR;
closedir THATDIR;
*****
readlink "/usr/local/src/express/yourself.h"
*****
../express.1.23/includes/yourself.h
*****
# A loop that joins lines continued with a backslash.
LINE: while (<STDIN>) {
    if (s/\\\n$// and $nextline = <STDIN>) {
        $_ .= $nextline;
        redo LINE;
    }
    print;  # or whatever...
}
*****
if (ref($r) eq "HASH") {
    print "r is a reference to a hash.\n";
} 
elsif (ref($r) eq "Hump") {
    print "r is a reference to a Hump object.\n";
} 
elsif (not ref $r) {
    print "r is not a reference at all.\n";
} 
*****
rename OLDNAME, NEWNAME
*****
require EXPR
require
*****
sub require {
    my($filename) = @_;
    return 1 if $INC{$filename};
    my($realfilename, $result);
    ITER: {
        foreach $prefix (@INC) {
            $realfilename = "$prefix/$filename";
            if (-f $realfilename) {
                $result = eval `cat $realfilename`;
                last ITER;
            }
        }
        die "Can't find $filename in \@INC";
    }
    die $@ if $@;
    die "$filename did not return true value" unless $result;
    $INC{$filename} = $realfilename;
    return $result;
}
*****
require 5.003;
*****
require Socket; # instead of "use Socket;"
*****
use Socket ();
*****
reset 'X';
*****
reset 'a-z';
*****
reset;
*****
for (reverse 1 .. 10) { ... }
*****
%barfoo = reverse %foobar;
*****
$pos = length $string;
while (($pos = rindex $string, $lookfor, $pos) >= 0) {
    print "Found at $pos\n";
    $pos--;
}
*****
local($nextvar) = scalar <STDIN>;
*****
local $nextvar = <STDIN>;
*****
print "Length is ", scalar(@ARRAY), "\n";
*****
for (;;) {
    while (<LOG>) {
        ...           # Process file.
    }
    sleep 15;
    seek LOG,0,1;      # Reset end-of-file error.
}
*****
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;
}
*****
select REPORT1;
$^ = 'MyTop';
select REPORT2;
$^ = 'MyTop';
*****
my $oldfh = select STDERR; $| = 1; select $oldfh;
*****
select((select(STDERR), $| = 1)[0])
*****
use FileHandle;
STDOUT->autoflush(1);
*****
use FileHandle;
REPORT1->format_top_name("MyTop");
REPORT2->format_top_name("MyTop");
*****
$rin = $win = $ein = '';
vec($rin, fileno(STDIN), 1) = 1;
vec($win, fileno(STDOUT), 1) = 1;
$ein = $rin | $win;
*****
sub fhbits {
    my @fhlist = @_;
    my $bits;
    for (@fhlist) {
        vec($bits, fileno($_), 1) = 1;
    }
    return $bits;
}
$rin = fhbits(qw(STDIN TTY MYSOCK));
*****
($nfound, $timeleft) =
    select($rout=$rin, $wout=$win, $eout=$ein, $timeout);
*****
$nfound = select($rout=$rin, $wout=$win, $eout=$ein, undef);
*****
select undef, undef, undef, 4.75;
*****
require "ipc.ph";
require "sem.ph";
$semop = pack "s*", $semnum, -1, 0;
die "Semaphore trouble: $!\n" unless semop $semid, $semop;
*****
use Socket;
...
setsockopt(MYSOCK, SOL_SOCKET, SO_REUSEADDR, 1)
        or warn "Can't do setsockopt: $!\n";
*****
sub asin { atan2($_[0], sqrt(1 - $_[0] * $_[0])) }
*****
sub numerically { $a <=> $b; }
@sortedbynumber = sort numerically 53,29,11,32,7;
*****
sub byage {
    $age{$a} <=> $age{$b};
}
@sortedclass = sort byage @class;
*****
sub prospects {
    $money{$b} <=> $money{$a}
       or
    $height{$b} <=> $height{$a}
       or
    $age{$a} <=> $age{$b}
       or
    $lastname{$a} cmp $lastname{$b}
       or
    $a cmp $b;
}
@sortedclass = sort prospects @class;
*****
@sorted = sort { lc($a) cmp lc($b) } @unsorted;
*****
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 reverse sort @harry;           # prints xdogcatCainAbel
print sort @george, "to", @harry;    # Remember, it's one LIST.
        # prints AbelAxedCainPunishedcatchaseddoggonetoxyz
*****
sub list_eq {       # 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 (list_eq($len, @foo[1..$len], scalar(@bar), @bar)) { ... }
*****
@chars = split //, $word;
@fields = split /:/, $line;
@words = split ' ', $paragraph;
@lines = split /^/m, $buffer;
*****
print join ':', split / */, 'hi there';
*****
($login, $passwd, $remainder) = split /:/, $_, 3;
*****
split /([-,])/, "1-10,20";
*****
(1, '-', 10, ',', 20)
*****
split /(-)|(,)/, "1-10,20";
*****
(1, '-', undef, 10, undef, ',', 20)
*****
$header =~ s/\n\s+/ /g;      # Merge continuation lines.
%head = ('FRONTSTUFF', split /^([-\w]+):/m, $header);
*****
open PASSWD, '/etc/passwd';
while (<PASSWD>) {
    chop;        # remove trailing newline
    ($login, $passwd, $uid, $gid, $gcos, $home, $shell) =
            split /:/;
    ...
}
*****
$width = 20; $value = sin 1.0;
foreach $precision (0..($width-2)) {
    printf "%${width}.${precision}f\n", $value;
}
*****
srand( time() ^ ($$ + ($$ << 15)) );
*****
srand (time ^ $$ ^ unpack "%L*", `ps axww | gzip`);
*****
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
    $atime,$mtime,$ctime,$blksize,$blocks)
            = stat $filename;
*****
if (-x $file and ($d) = stat(_) and $d < 0) {
    print "$file is executable NFS file\n";
}
*****
while (<>) {
    study;
    print ".IX foo\n" if /\bfoo\b/;
    print ".IX bar\n" if /\bbar\b/;
    print ".IX blurfl\n" if /\bblurfl\b/;
    ...
    print;
}
*****
$search = 'while (<>) { study;';
foreach $word (@words) {
    $search .= "++\$seen{\$ARGV} if /\b$word\b/;\n";
}
$search .= "}";
@ARGV = @files;
undef $/;               # slurp each entire file
eval $search;           # this screams
die $@ if $@;           # in case eval failed
$/ = "\n";              # put back to normal input delim
foreach $file (sort keys(%seen)) {
    print $file, "\n";
}
*****
substr($_, 0, 0) = "Larry";
*****
substr($_, 0, 1) = "Moe";
*****
substr($_, -1, 1) = "Curly";
*****
$symlink_exists = (eval { symlink("", ""); }, $@ eq '');
*****
require 'syscall.ph';
syscall &SYS_setgroups, @groups+0, pack("i*", @groups);
*****
@args = ("command", "arg1", "arg2");
system(@args) == 0 
     or die "system @args failed: $?" 
*****
$rc = 0xffff & system @args;
printf "system(%s) returned %#04x: ", "@args", $rc;
if ($rc == 0) {
    print "ran with normal exit\n";
} 
elsif ($rc == 0xff00) {
    print "command failed: $!\n";
} 
elsif ($rc > 0x80) {
    $rc >>= 8;
    print "ran with non-zero exit status $rc\n";
} 
else {
    print "ran with ";
    if ($rc &   0x80) {
        $rc &= ~0x80;
        print "coredump from ";
    } 
    print "signal $rc\n"
} 
$ok = ($rc != 0);
*****
$blksize = (stat FROM)[11] || 16384;  # preferred block size?
while ($len = sysread FROM, $buf, $blksize) {
    if (!defined $len) {
        next if $! =~ /^Interrupted/;
        die "System read error: $!\n";
    }
    $offset = 0;
    while ($len) {          # Handle partial writes.
        $written = syswrite TO, $buf, $len, $offset;
        die "System write error: $!\n"
            unless defined $written;
        $len -= $written;
        $offset += $written;
    };
}
*****
use NDBM_File;
tie %ALIASES, "NDBM_File", "/etc/aliases", 1, 0
    or die "Can't open aliases: $!\n";
while (($key,$val) = each %ALIASES) {
    print $key, ' = ', $val, "\n";
}
untie %ALIASES;
*****
ref tied %hash
*****
($user, $system, $cuser, $csystem) = times;
*****
$start = (times)[0];
...
$end = (times)[0];
printf "that took %.2f CPU seconds\n", $end - $start;
*****
umask((umask & 077) | 7);
*****
undef $foo;
undef $bar{'blurfl'};
undef @ary;
undef %assoc;
undef &mysub;
*****
return (wantarray ? () : undef) if $they_blew_it;
select(undef, undef, undef, $naptime);
*****
$cnt = unlink 'a', 'b', 'c';
unlink @goners;
unlink <*.bak>;
*****
#!/usr/bin/perl
@cannot = grep {not unlink} @ARGV;
die "$0: could not unlink @cannot\n" if @cannot;
*****
sub substr {
    my($what, $where, $howmuch) = @_;
    if ($where < 0) {
        $where = -$where;
        unpack "@* X$where a$howmuch", $what;
    }
    else {
        unpack "x$where a$howmuch", $what;
    }
}
*****
sub signed_ord { unpack "c", shift }
*****
#!/usr/bin/perl
$_ = <> until ($mode,$file) = /^begin\s*(\d*)\s*(\S*)/;
open(OUT,"> $file") if $file ne "";
while (<>) {
    last if /^end/;
    next if /[a-z]/;
    next unless int((((ord() - 32) & 077) + 2) / 3) ==
                int(length() / 4);
    print OUT unpack "u", $_;
}
chmod oct $mode, $file;
*****
undef $/;
$checksum = unpack ("%32C*", <>) % 32767;
*****
$setbits = unpack "%32b*", $selectmask;
*****
unshift @ARGV, '-e', $cmd unless $ARGV[0] =~ /^-/;
*****
while (<>) {
  tr#A-Za-z0-9+/##cd;                   # remove non-base64 chars
  tr#A-Za-z0-9+/# -_#;                  # convert to uuencoded format
  $len = pack("c", 32 + 0.75*length);   # compute length byte
  print unpack("u", $len . $_);         # uudecode and print
}
*****
BEGIN { require Module; import Module LIST; }
*****
use Module ();
*****
BEGIN { require Module; }
*****
use integer;
use diagnostics;
use sigtrap qw(SEGV BUS);
use strict  qw(subs vars refs);
use subs    qw(afunc blurfl);
*****
no integer;
no strict 'refs';
*****
#!/usr/bin/perl
$now = time;
utime $now, $now, @ARGV;
*****
#!/usr/bin/perl
$now = time;
@cannot = grep {not utime $now, $now, $_} @ARGV;
die "$0: Could not touch @cannot.\n" if @cannot;
*****
$now = time;
foreach $file (@ARGV) {
    utime $now, $now, $file
        or open TMP, ">>$file"
        or warn "Couldn't touch $file: $!\n";
}
*****
$SIG{CHLD} = sub { wait };
*****
use POSIX "wait_h";
*****
return wantarray ? () : undef;
*****
warn "Debug enabled" if $debug;
*****
use FileHandle;
HANDLE->format_name("NEWNAME");
*****
use FileHandle;
HANDLE->format_top_name("NEWNAME_TOP");
*****