12345               # integer
12345.67            # floating point
6.02E23             # scientific notation
0xffff              # hexadecimal
0377                # octal
4_294_967_296       # underline for legibility
*****
$Price = '$100';                    # not interpolated
print "The price is $Price.\n";     # interpolated
*****
$days{'Feb'}
*****
$days{Feb}
*****
$single = q!I said, "You said, 'She said it.'"!;
$double = qq(Can't we get some "good" $variable?);
$chunk_of_code = q {
    if ($condition) {
        print "Gotcha!";
    }
};
*****
tr [a-z]
   [A-Z];
*****
@days = (Mon,Tue,Wed,Thu,Fri);
print STDOUT hello, ' ', world, "\n";
*****
use strict 'subs';
*****
no strict 'subs';
*****
"${verb}able"
$days{Feb}
*****
$temp = join($",@ARGV);
print $temp;

print "@ARGV";
*****
@stuff = ("one", "two", "three");
*****
$stuff = ("one", "two", "three");
*****
@stuff = ("one", "two", "three");
$stuff = @stuff;      # $stuff gets 3, not "three"
*****
(@foo,@bar,&SomeSub)
*****
@numbers = (
    1,
    2,
    3,
);
*****
@foo = qw(
    apple       banana      carambola
    coconut     guava       kumquat
    mandarin    nectarine   peach
    pear        persimmon   plum
);
*****
# Stat returns list value.
$modification_time = (stat($file))[8];

# SYNTAX ERROR HERE.
$modification_time = stat($file)[8];  # OOPS, FORGOT PARENS

# Find a hex digit.
$hexdigit = ('a','b','c','d','e','f')[$digit-10];

# A "reverse comma operator".
return (pop(@foo),pop(@foo))[0];
*****
($a, $b, $c) = (1, 2, 3);

($map{red}, $map{green}, $map{blue}) = (0x00f, 0x0f0, 0xf00);
*****
$x = ( ($foo,$bar) = (7,7,7) );       # set $x to 3, not 2
$x = ( ($foo,$bar) = f() );           # set $x to f()'s return count
*****
($a, $b, @rest) = split;
my ($a, $b, %rest) = @arg_list;
*****
@days + 0;      # implicitly force @days into a scalar context
scalar(@days)   # explicitly force @days into a scalar context
*****
@whatever = ();
$#whatever = -1;
*****
scalar(@whatever) == $#whatever + 1;
*****
%map = ('red',0x00f,'green',0x0f0,'blue',0xf00);
*****
%map = ();            # clear the hash first
$map{red}   = 0x00f;
$map{green} = 0x0f0;
$map{blue}  = 0xf00;
*****
%map = (
    red   => 0x00f,
    green => 0x0f0,
    blue  => 0xf00,
);
*****
$rec = {
    witch => 'Mable the Merciless',
    cat   => 'Fluffy the Ferocious',
    date  => '10/31/1776',
};
*****
$field = $query->radio_group( 
                    NAME      => 'group_name',
                    VALUES    => ['eenie','meenie','minie'],
                    DEFAULT   => 'meenie',
                    LINEBREAK => 'true',
                    LABELS    => \%labels,
                );
*****
$fh = *STDOUT;
*****
$fh = \*STDOUT;
*****
*foo = *bar;
*****
*foo = \$bar;
*****
$info = `finger $user`;
*****
while (defined($_ = <STDIN>)) { print $_; }   # the long way
while (<STDIN>) { print; }                    # the short way
for (;<STDIN>;) { print; }                    # while loop in disguise
print $_ while defined($_ = <STDIN>);         # long statement modifier
print while <STDIN>;                          # short statement modifier
*****
if (<STDIN>)      { print; }   # WRONG, prints old value of $_
if ($_ = <STDIN>) { print; }   # okay
*****
$one_line = <MYFILE>;   # Get first line.
@all_lines = <MYFILE>;  # Get the rest of the lines.
*****
while (<>) {
    ...                     # code for each line
}
*****
$fh = \*STDIN;
$line = <$fh>;
*****
my @files = <*.html>;
*****
while (<*.c>) {
    chmod 0644, $_;
}
*****
open(FOO, "echo *.c | tr -s ' \t\r\f' '\\012\\012\\012\\012'|");
while (<FOO>) {
    chop;
    chmod 0644, $_;
}
*****
chmod 0644, <*.c>;
*****
($file) = <blurch*>;  # list context
*****
$file = <blurch*>;    # scalar context
*****
@files = glob("$dir/*.[ch]");   # call glob as function
@files = glob $some_pattern;    # call glob as operator
*****
/Fred/
*****
/Fred|Wilma|Barney|Betty/
*****
/(Fred|Wilma|Pebbles) Flintstone/
*****
/(moo){3}/
*****
$foo = "moo";
/$foo$/;
*****
/moo$/;
*****
/x*y*/
*****
1 while s/pattern/length($`)/e;
*****
1 while s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;
*****
s/^([^ ]+) +([^ ]+)/$2 $1/;   # swap first two words

/(\w+)\s*=\s*\1/;             # match "foo = foo"

/.{80,}/;                     # match line of at least 80 chars

/^(\d+\.?\d*|\.\d+)$/;        # match valid number

if (/Time: (..):(..):(..)/) { # pull fields out of a line
        $hours = $1;
        $minutes = $2;
        $seconds = $3;
}
*****
$_ = <STDIN>;
s/.*(some_string).*/$1/;
*****
s/.*(some_string).*/$1/s;
s/.*(some_string).*\n/$1/;
s/.*(some_string)[^\000]*/$1/;
s/.*(some_string)(.|\n)*/$1/;

chop; s/.*(some_string).*/$1/;
/(some_string)/ && ($_ = $1);
*****
$pattern =~ s/(\W)/\\$1/g;
*****
/$unquoted\Q$quoted\E$unquoted/
*****
/^fee|fie|foe$/
*****
/^(fee|fie|foe)$/
*****
split(/\b(?:a|b|c)\b/)
*****
split(/\b(a|b|c)\b/)
*****
if (/foo/ and $` !~ /bar$/)
*****
# hardwired case insensitivity
$pattern = "buffalo";
if ( /$pattern/i )

# data-driven case insensitivity
$pattern = "(?i)buffalo";
if ( /$pattern/ )
*****
# case insensitive matching
open(TTY, '/dev/tty');
<TTY> =~ /^y/i and foo();    # do foo() if they want it

# pulling a substring out of a line
if (/Version: *([0-9.]+)/) { $version = $1; }

# avoiding Leaning Toothpick Syndrome
next if m#^/usr/spool/uucp#;

# poor man's grep
$arg = shift;
while (<>) {
    print if /$arg/o;       # compile only once
}

# get first two words and remainder as a list
if (($F1, $F2, $Etc) = ($foo =~ /^\s*(\S+)\s+(\S+)\s*(.*)/))
*****
if (($F1, $F2, $Etc) = split(' ', $foo, 3))
*****
# list context--extract three numeric fields from uptime command
($one,$five,$fifteen) = (`uptime` =~ /(\d+\.\d+)/g);

# scalar context--count sentences in a document by recognizing
# sentences ending in [.!?], perhaps with quotes or parens on 
# either side.  Observe how dot in the character class is a literal
# dot, not merely any character.
$/ = "";  # paragraph mode
while ($paragraph = <>) {
    while ($paragraph =~ /[a-z]['")]*[.!?]+['")]*\s/g) {
        $sentences++;
    }
}
print "$sentences\n";

# find duplicate words in paragraphs, possibly spanning line boundaries.
#   Use /x for space and comments, /i to match the both `is' 
#   in "Is is this ok?", and use /g to find all dups.
$/ = '';        # paragrep mode again
while (<>) {
    while ( m{
                \b            # start at a word boundary
                (\S+)         # find a text chunk
                ( 
                    \s+       # separated by some whitespace
                    \1        # and that chunk again
                ) +           # repeat ad lib
                \b            # until another word boundary
             }xig
         ) 
    {
        print "dup word `$1' at paragraph $.\n";
    } 
} 
*****
# don't change wintergreen
s/\bgreen\b/mauve/g;

# avoid LTS with different quote characters
$path =~ s(/usr/bin)(/usr/local/bin);

# interpolated pattern and replacement
s/Login: $foo/Login: $bar/;

# modifying a string "en passant"
($foo = $bar) =~ s/this/that/;

# counting the changes
$count = ($paragraph =~ s/Mister\b/Mr./g);

# using an expression for the replacement
$_ = 'abc123xyz';
s/\d+/$&*2/e;               # yields 'abc246xyz'
s/\d+/sprintf("%5d",$&)/e;  # yields 'abc  246xyz'
s/\w/$& x 2/eg;             # yields 'aabbcc  224466xxyyzz'

# how to default things with /e
s/%(.)/$percent{$1}/g;            # change percent escapes; no /e
s/%(.)/$percent{$1} || $&/ge;     # expr now, so /e
s/^=(\w+)/&pod($1)/ge;            # use function call

# /e's can even nest; this will expand simple embedded variables in $_
s/(\$\w+)/$1/eeg;

# delete C comments
$program =~ s {
    /\*     # Match the opening delimiter.
    .*?     # Match a minimal number of characters.
    \*/     # Match the closing delimiter.
} []gsx;

# trim white space
s/^\s*(.*?)\s*$/$1/;

# reverse 1st two fields
s/([^ ]*) *([^ ]*)/$2 $1/;
*****
$pattern =~ s/(\W)/\\\1/g;
*****
s/(\d+)/ \1 + 1 /eg;   # a scalar reference plus one?
*****
s/(\d+)/\1000/;        # "\100" . "0" == "@0"?
*****
# put commas in the right places in an integer
1 while s/(\d)(\d\d\d)(?!\d)/$1,$2/g;

# expand tabs to 8-column spacing
1 while s/\t+/' ' x (length($&)*8 - length($`)%8)/e;
*****
$ARGV[1] =~ tr/A-Z/a-z/;    # canonicalize to lower case

$cnt = tr/*/*/;             # count the stars in $_

$cnt = $sky =~ tr/*/*/;     # count the stars in $sky

$cnt = tr/0-9//;            # count the digits in $_

tr/a-zA-Z//s;               # bookkeeper -> bokeper

($HOST = $host) =~ tr/a-z/A-Z/;

tr/a-zA-Z/ /cs;             # change non-alphas to single space

tr [\200-\377]
   [\000-\177];             # delete 8th bit
*****
tr/AAA/XYZ/
*****
eval "tr/$oldlist/$newlist/";
die $@ if $@;

eval "tr/$oldlist/$newlist/, 1" or die $@;
*****
chdir $foo    || die;       # (chdir $foo) || die
chdir($foo)   || die;       # (chdir $foo) || die
chdir ($foo)  || die;       # (chdir $foo) || die
chdir +($foo) || die;       # (chdir $foo) || die
*****
chdir $foo * 20;            # chdir ($foo * 20)
chdir($foo) * 20;           # (chdir $foo) * 20
chdir ($foo) * 20;          # (chdir $foo) * 20
chdir +($foo) * 20;         # chdir ($foo * 20)
*****
rand 10 * 20;               # rand (10 * 20)
rand(10) * 20;              # (rand 10) * 20
rand (10) * 20;             # (rand 10) * 20
rand +(10) * 20;            # rand (10 * 20)
*****
@ary = (1, 3, sort 4, 2);
print @ary;         # prints 1324
*****
# These evaluate exit before doing the print:
print($foo, exit);  # Obviously not what you want.
print $foo, exit;   # Nor is this.

# These do the print before evaluating exit:
(print $foo), exit; # This is what you want.
print($foo), exit;  # Or this.
print ($foo), exit; # Or even this.
*****
print ($foo & 255) + 1, "\n";   # prints ($foo & 255)
*****
print ++($foo = '99');      # prints '100'
print ++($foo = 'a0');      # prints 'a1'
print ++($foo = 'Az');      # prints 'Ba'
print ++($foo = 'zz');      # prints 'aaa'
*****
$string !~ /pattern/
not $string =~ /pattern/
*****
while ( ($k,$v) = $string =~ m/(\w+)=(\w*)/g ) {
    print "KEY $k VALUE $v\n";
}
*****
print '-' x 80;             # print row of dashes

print "\t" x ($tab/8), ' ' x ($tab%8);      # tab over
*****
@ones = (1) x 80;           # a list of 80 1's
@ones = (5) x @ones;        # set all elements to 5
*****
@keys = qw(perls before swine);
@hash{@keys} = ("") x @keys;
*****
$hash{perls}  = "";
$hash{before} = "";
$hash{swine}  = "";
*****
$almost = "Fred" . "Flintstone";    # returns FredFlintstone
*****
$fullname = "$firstname $lastname";
*****
1 << 4;     # returns 16
32 >> 4;    # returns 2
*****
sleep 4 | 3;
*****
(sleep 4) | 3;
*****
print 4 | 3;
*****
print (4 | 3);
*****
next if length < 80;
*****
next if length() < 80;
next if (length) < 80;
next if 80 > length;
next unless length >= 80;
*****
while (<>) {
    chomp;
    next unless -f $_;      # ignore "special" files
    ...
}
*****
next unless -f $file && -T _;
*****
print "Can do.\n" if -r $a || -w _ || -x _;

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 _;
*****
next unless -M $file > .5;      # files older than 12 hours
&newfile if -M $file < 0;       # file is newer than process
&mailwarning if int(-A) == 90;  # file ($_) accessed 90 days ago today
*****
$^T = time;
*****
"123.45" & "234.56"
*****
"020.44:
*****
"123.45" & 234.56
*****
123.45 & 234.56
*****
123 & 234
*****
if ( "fred" & "\1\2\3\4" ) { ... }
*****
if ( ("fred" & "\1\2\3\4") !~ /^\0+$/ ) { ... }
*****
open(FILE, "somefile") || die "Cannot open somefile: $!\n";
*****
$home = $ENV{HOME} 
     || $ENV{LOGDIR} 
     || (getpwuid($<))[7] 
     || die "You're homeless!\n";
*****
for (1 .. 1_000_000) {
    # code
} 
*****
if (101 .. 200) { print; }  # print 2nd hundred lines
next line if (1 .. /^$/);   # skip header lines
s/^/> / if (/^$/ .. eof()); # quote body
*****
for (101 .. 200) { print; } # prints 100101102...199200
@foo = @foo[0 .. $#foo];   # an expensive no-op
@foo = @foo[ $#foo - 4 .. $#foo];      # slice last 5 items
*****
@alphabet = ('A' .. 'Z');
*****
$hexdigit = (0 .. 9, 'a' .. 'f')[$num & 15];
*****
@z2 = ('01' .. '31');  print $z2[$mday];
*****
@combos = ('aa' .. 'zz');
*****
@bigcombos = ('aaaaaa' .. 'zzzzzz');
*****
printf "I have %d dog%s.\n", $n, 
        ($n == 1) ? '' : "s";
*****
$a = $ok ? $b : $c;  # get a scalar
@a = $ok ? @b : @c;  # get an array
$a = $ok ? @b : @c;  # get a count of elements in one of the arrays
*****
($a_or_b ? $a : $b) = $c;  # sets either $a or $b to equal $c
*****
$var[$a++] += $value;               # $a is set to $a + 1
$var[$a++] = $var[$a++] + $value;   # $a is set to $a + 2
*****
($tmp = $global) += $constant;
*****
$tmp = $global + $constant;
*****
($a += 2) *= 3;
*****
$a += 2;
$a *= 3;
*****
($new = $old) =~ s/foo/bar/g;
*****
$a = $b = $c = 0;
*****
while (($key, $value) = each %gloss) { ... }

next unless ($dev, $ino, $mode) = stat $file;
*****
$a = (1, 3);
*****
@a = (1, 3);
*****
atan2(1, 3);
*****
unlink "alpha", "beta", "gamma"
        or gripe(), next LINE;
*****
unlink("alpha", "beta", "gamma")
        || (gripe(), next LINE);
*****
$ref_to_var = \$var;
*****
$trash->take('out') if $you_love_me;
shutup() unless $you_want_me_to_leave;
*****
$expression++ while -e "$file$expression";
kiss('me') until $I_die;
*****
do {
    $line = <STDIN>;
    ...
} until $line eq ".\n";
*****
if (!open(FOO, $foo)) { die "Can't open $foo: $!"; }

die "Can't open $foo: $!" unless open(FOO, $foo);

open(FOO, $foo) or die "Can't open $foo: $!";     # FOO or bust!

open(FOO, $foo) ? 'hi mom' : die "Can't open $foo: $!";
                    # a bit exotic, that last one
*****
unless ($OS_ERROR) ...
*****
if (not $OS_ERROR) ...
*****
for ($i = 1; $i < 10; $i++) {
    ...
}
*****
$i = 1;
while ($i < 10) {
    ...
}
continue {
    $i++;
}
*****
for ($i = 0, $bit = 1; $mask & $bit; $i++, $bit << 1) {
    print "Bit $i is set\n";
}
*****
$on_a_tty = -t STDIN && -t STDOUT;
sub prompt { print "yes? " if $on_a_tty }
for ( prompt(); <STDIN>; prompt() ) {
    # do something
} 
*****
for (;;) {
    ...
}
*****
for (@ary) { s/ham/turkey/ }                # substitution

foreach $elem (@elements) {                 # multiply by 2
    $elem *= 2;
}

for $count (10,9,8,7,6,5,4,3,2,1,'BOOM') {  # do a countdown
    print $count, "\n"; sleep(1);
}

for $count (reverse 'BOOM', 1..10) {        # same thing
    print $count, "\n"; sleep(1);
}

for $item (split /:[\\\n:]*/, $TERMCAP) {   # any LIST expression
    print "Item: $item\n";
}

foreach $key (sort keys %hash) {            # sorting keys
    print "$key => $hash{$key}\n";
}
*****
for ($i = 0; $i < @ary1; $i++) {
    for ($j = 0; $j < @ary2; $j++) {
        if ($ary1[$i] > $ary2[$j]) {
            last; # can't go to outer :-(
        }
        $ary1[$i] += $ary2[$j];
    }
    # this is where that last takes me
}
*****
WID: foreach $this (@ary1) { 
    JET: foreach $that (@ary2) {
        next WID if $this > $that;
        $this += $that;
    } 
} 
*****
next LINE if /^#/;      # discard comments
*****
LINE: while (<STDIN>) {
    last LINE if /^$/;      # exit when done with header
    ...
}
*****
LINE: while (<STDIN>) {
    next LINE if /^#/;      # skip comments
    next LINE if /^$/;      # skip blank lines
    ...
} continue {
    $count++;
}
*****
while (<>) {
    chomp;
    if (s/\\$//) { 
        $_ .= <>; 
        redo;
    }
    # now process $_
} 
*****
LINE: while ($line = <ARGV>) {
    chomp($line);
    if ($line =~ s/\\$//) { 
        $line .= <ARGV>; 
        redo LINE;
    }
    # now process $line
} 
*****
open FILE, $file
     or warn "Can't open $file: $!\n", next FILE;   # WRONG
*****
open FILE, $file
     or warn("Can't open $file: $!\n"), next FILE;   # okay
*****
SWITCH: {
    if (/^abc/) { $abc = 1; last SWITCH; }
    if (/^def/) { $def = 1; last SWITCH; }
    if (/^xyz/) { $xyz = 1; last SWITCH; }
    $nothing = 1;
}
*****
SWITCH: {
    $abc = 1, last SWITCH  if /^abc/;
    $def = 1, last SWITCH  if /^def/;
    $xyz = 1, last SWITCH  if /^xyz/;
    $nothing = 1;
}
*****
SWITCH: {
    /^abc/ && do { $abc = 1; last SWITCH; };
    /^def/ && do { $def = 1; last SWITCH; };
    /^xyz/ && do { $xyz = 1; last SWITCH; };
    $nothing = 1;
}
*****
SWITCH: {
    /^abc/      && do { 
                        $abc = 1; 
                        last SWITCH; 
                   };
    /^def/      && do { 
                        $def = 1; 
                        last SWITCH; 
                   };
    /^xyz/      && do { 
                        $xyz = 1; 
                        last SWITCH; 
                    };
    $nothing = 1;
}
*****
SWITCH: {
    /^abc/      and $abc = 1, last SWITCH;
    /^def/      and $def = 1, last SWITCH;
    /^xyz/      and $xyz = 1, last SWITCH;
    $nothing = 1;
}
*****
if    (/^abc/) { $abc = 1 }
elsif (/^def/) { $def = 1 }
elsif (/^xyz/) { $xyz = 1 }
else           { $nothing = 1 }
*****
for ($some_ridiculously_long_variable_name) {
    /In Card Names/     and do { push @flags, '-e'; last; };
    /Anywhere/          and do { push @flags, '-h'; last; };
    /In Rulings/        and do {                    last; };
    die "unknown value for form variable where: `$where'";
} 
*****
goto ("FOO", "BAR", "GLARCH")[$i];
*****
sub myname;
$me = myname $0             or die "can't get myname";
*****
my $name = "fred";
my @stuff = ("car", "house", "club");
my ($vehicle, $home, $tool) = @stuff;
*****
my ($foo) = <STDIN>;
my @FOO = <STDIN>;
*****
my $foo = <STDIN>;
*****
my $foo, $bar = 1;
*****
my $foo;
$bar = 1;
*****
my $x = $x;
*****
my $x = 123 and $x == 123
*****
$PackageName::varname
*****
use integer
use strict
use lib
use sigtrap
use subs
use vars
*****
use integer;
*****
no integer;
*****
use strict 'vars';
*****
no strict 'vars'
*****
use subs qw(&read &write);
*****
use vars qw($fee $fie $foe $foo @sic);
*****
use lib "/my/own/lib/directory";
*****
sub NAME;              # A "forward" declaration.
sub NAME (PROTO);      # Ditto, but with prototype.
*****
use PACKAGE qw(NAME1 NAME2 NAME3...);
*****
&$subref(LIST);        # & is not optional on indirect call.
&$subref;              # Passes current @_ to subroutine.
*****
sub max {
    my $max = shift(@_);
    foreach $foo (@_) {
        $max = $foo if $max < $foo;
    }
    return $max;
}
$bestday = max($mon,$tue,$wed,$thu,$fri);
*****
sub maybeset {
    my($key, $value) = @_;
    $Foo{$key} = $value unless $Foo{$key};
}
*****
upcase_in($v1, $v2);  # this changes $v1 and $v2
sub upcase_in {
    for (@_) { tr/a-z/A-Z/ } 
} 
*****
upcase_in("frederick");
*****
($v3, $v4) = upcase($v1, $v2);
sub upcase {
    my @parms = @_;
    for (@parms) { tr/a-z/A-Z/ } 
    # wantarray checks whether we were called in list context
    return wantarray ? @parms : $parms[0];
} 
*****
@newlist   = upcase(@list1, @list2);
@newlist   = upcase( split /:/, $var );
*****
(@a, @b)   = upcase(@list1, @list2);   # WRONG
*****
&foo(1,2,3);    # pass three arguments
foo(1,2,3);     # the same

foo();          # pass a null list
&foo();         # the same

&foo;           # foo() gets current args, like foo(@_) !!
foo;            # like foo() IFF sub foo pre-declared, else bareword "foo"
*****
sub doubleary {
    local(*someary) = @_;
    foreach $elem (@someary) {
        $elem *= 2;
    }
}
doubleary(*foo);
doubleary(*bar);
*****
@tailings = popmany ( \@a, \@b, \@c, \@d );

sub popmany {
    my $aref;
    my @retlist = ();
    foreach $aref ( @_ ) {
        push @retlist, pop @$aref;
    } 
    return @retlist;
} 
*****
@common = inter( \%foo, \%bar, \%joe ); 
sub inter {
    my ($k, $href, %seen); # locals
    foreach $href (@_) {
        while ( $k = each %$href ) {
            $seen{$k}++;
        } 
    } 
    return grep { $seen{$_} == @_ } keys %seen;
} 
*****
(@a, @b) = func(@c, @d);
*****
(%a, %b) = func(%c, %d);
*****
($aref, $bref) = func(\@c, \@d);
print "@$aref has more than @$bref\n";
sub func {
    my ($cref, $dref) = @_;
    if (@$cref > @$dref) {
        return ($cref, $dref);
    } else {
        return ($dref, $cref);
    } 
} 
*****
(*a, *b) = func(\@c, \@d);
print "@a has more than @b\n";
sub func {
    local (*c, *d) = @_;
    if (@c > @d) {
        return (\@c, \@d);
    } else {
        return (\@d, \@c);
    } 
} 
*****
splutter(\*STDOUT);
sub splutter {
    my $fh = shift;
    print $fh "her um well a hmmm\n";
}

$rec = get_rec(\*STDIN);
sub get_rec {
    my $fh = shift;
    return scalar <$fh>;
}
*****
sub openit {
    my $name = shift;
    local *FH;
    return open (FH, $path) ? \*FH : undef;
} 
*****
sub mypush (\@@)
*****
mytime +2;
*****
sub try (&$) {
    my($try,$catch) = @_;
    eval { &$try };
    if ($@) {
        local $_ = $@;
        &$catch;
    }
}
sub catch (&) { @_ }

try {
    die "phooey";
} catch {
    /phooey/ and print "unphooey\n";
};
*****
sub mygrep (&@) {
    my $coderef = shift;
    my @result;
    foreach $_ (@_) {
        push(@result, $_) if &$coderef;
    }
    @result;
}
*****
sub func ($) {
    my $n = shift;
    print "you gave me $n\n";
} 
*****
func(@foo);
func( split /:/ );
*****
select((select(OUTF), 
        $~ = "My_Other_Format",
        $^ = "My_Top_Format"
       )[0]);
*****
$ofh = select(OUTF);
$~ = "My_Other_Format";
$^ = "My_Top_Format";
select($ofh);
*****
use English;
$ofh = select(OUTF);
$FORMAT_NAME     = "My_Other_Format";
$FORMAT_TOP_NAME = "My_Top_Format";
select($ofh);
*****
use FileHandle;
OUTF->format_name("My_Other_Format");
OUTF->format_top_name("My_Top_Format");
*****
format Ident = 
    @<<<<<<<<<<<<<<<
    commify($n)
.
*****
format Ident = 
I have an @ here.
         "@"
.
*****
format Ident = 
@||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
                          "Some text line"
.
*****
$str = formline <<'END', 1,2,3;
@<<<  @|||  @>>>
END

print "Wow, I just stored `$^A' in the accumulator!\n";
*****
use Carp;
sub swrite {
    croak "usage: swrite PICTURE ARGS" unless @_;
    my $format = shift;
    $^A = "";
    formline($format,@_);
    return $^A;
} 

$string = swrite(<<'END', 1, 2, 3);
Check me out
@<<<  @|||  @>>>
END
print $string;
*****
use English;
*****
$_ = 'abcdefghi';
/def/;
print "$`:$&:$'\n";         # prints abc:def:ghi
*****
/Version: (.*)|Revision: (.*)/ && ($rev = $+);
*****
use FileHandle;
*****
while (<>) {...}    # only equivalent in while!
while (defined($_ = <>)) {...}

/^Subject:/
$_ =~ /^Subject:/

tr/a-z/A-Z/
$_ =~ tr/a-z/A-Z/

chop
chop($_)
*****
undef $/;
$_ = <FH>;          # whole file now here
s/\n[ \t]+/ /g;
*****
$foo{$a,$b,$c}
*****
$foo{join($;, $a, $b, $c)}
*****
@foo{$a,$b,$c}      # a slice--note the @
*****
($foo{$a},$foo{$b},$foo{$c})
*****
$< = $>;            # set real to effective uid
($<,$>) = ($>,$<);  # swap real and effective uid
*****
warn "No checksumming!\n" if $] < 3.019;
die "Must have prototyping available\n" if $] < 5.003;
*****
print "@INC\n";
print "@main::INC\n";
*****
/usr/local/lib/perl5/$ARCH/$VERSION
/usr/local/lib/perl5
/usr/local/lib/perl5/site_perl
/usr/local/lib/perl5/site_perl/$ARCH
*****
use lib '/mypath/libdir/';
use SomeMod;
*****
$ENV{PATH} = "/bin:/usr/bin";
*****
$SIG{PIPE} = Plumber;     # SCARY!!
$SIG{PIPE} = "Plumber";   # just fine, assumes main::Plumber
$SIG{PIPE} = \&Plumber;   # just fine; assume current Plumber
$SIG{PIPE} = Plumber();   # oops, what did Plumber() return??
*****
local $SIG{__WARN__} = sub { die $_[0] };
eval $proggie;
*****