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");

*****

