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;

*****

