::::::::::::::
README
::::::::::::::
There are 26 examples:

A. Example Files (These are executable perl scripts unless otherwise noted.):

example1
example2
example3
example4
example5
example6		- takes input from input6
example7
example8
example9
example10
example11
example12
example13
example14
example15
example16		- takes input from input16
example17
example18
example19
example20
example21
example22
example23
example24
example25
example26


B. Other Files:

file1			- text data file used by example17
prototypes		- this is identical to example12


C. Using these examples

All of the examples in this chapter are executable scripts that can be run
directly at the command line.

The ones that takes input from a provided input file can be run as follows:
> example6 < input6


::::::::::::::
example1
::::::::::::::
#! /usr/bin/perl

sub greetme { print "Welcome, Valkommen till, Benvenue a!\n";}
&greetme if defined &greetme;
print "Program continues....\n";
&greetme;
print "More program here.\n";
&bye;
sub bye { print "Bye, hej da, adieu.\n"; }
&bye;
::::::::::::::
example10
::::::::::::::
#! /usr/bin/perl

use strict "vars";
my $name = "Ellie"; # my (lexical) variables are ok
@friends = qw(Tom Stefan Bin Marie);
# global variables not allowed
local $newspaper = "The Globe"; # local variables are not allowed
print "My name is $name and our friends are @friends.\n";
::::::::::::::
example11
::::::::::::::
#! /usr/bin/perl

use strict "vars";
my $name = "Ellie"; # All variables are lexical in scope
our @friends = qw(Tom Stefan Bin Marie);
our $newspaper = "The Globe";
print "$name and $friends[0] read the $newspaper.\n";
::::::::::::::
example12
::::::::::::::
#! /usr/bin/perl
# Program name:  prototypes
# Testing prototyping
my $a=5;
my $b=6;
my $c=7;
@list=(100,200,300);

sub myadd($$) { # myadd requires two scalar arguments
    my($x, $y)=@_;
    print $x + $y,"\n";
}

myadd($a, $b); # Ok
myadd(5, 4); # Ok
myadd($a, $b, $c); # Too many arguments
::::::::::::::
example13
::::::::::::::
#! /usr/bin/perl

# Prototypes
sub mynumbs(@$;$); # Declaration with prototype
@list=(1,2,3);
mynumbs(@list, 25);

sub mynumbs(@$;$) { # Match the prototypes
    my ($scalar)=pop(@_);
    my(@arr) = @_;
    print "The array is: @arr","\n";
    print "The scalar is $scalar\n";
}
::::::::::::::
example14
::::::::::::::
#! /usr/bin/perl

sub MAX {
    my($max) = shift(@_);
    foreach $foo ( @_ ){
	$max = $foo if $max < $foo;
	print $max,"\n";
    }
    print "------------------------------\n";
    $max;
}

sub MIN {
    my($min) = pop( @_ );
    foreach $foo ( @_ ) {
	$min = $foo if $min > $foo;
	print $min,"\n";
    }
    print "------------------------------\n";
    return $min;
}

my $biggest = &MAX ( 2, 3, 4, 10, 100, 1 );
my $smallest= &MIN ( 200, 2, 12, 40, 2, 20 );
print "The biggest is $biggest and the smallest is $smallest.\n";
::::::::::::::
example15
::::::::::::::
#! /usr/bin/perl
$colors="rainbow";
@colors=("red", "green", "yellow" );
&printit(*colors); # Which color is this?

sub printit{
    local(*whichone)=@_; # Must use local, not my with globs
    print *whichone, "\n"; # The package is main
    $whichone="Prism of Light"; # Alias for the scalar
    $whichone[0]="PURPLE"; # Alias for the array
}

print "Out of subroutine.\n";
print "\$colors is $colors.\n";
print "\@colors is @colors.\n";
::::::::::::::
example16
::::::::::::::
#! /usr/bin/perl

# Revisiting Example 10.6 -- Now using typeglob
print "Give me 5 numbers: ";
@n = split(' ', <STDIN>);
&params(*n);

sub params{
    local(*arr)=@_;
    print 'The values of the @arr array are ', @arr, "\n";
    print "The first value is $arr[0]\n";
    print "the last value is ", pop(@arr), "\n";
    foreach $value(@arr){
	$value+=5;
	print "The value is $value.\n";
    }
}

print "Back in main\n";
print "The new values are @n.\n";
::::::::::::::
example17
::::::::::::::
#! /usr/bin/perl

open(READMEFILE, "file1") || die;
&readit(*READMEFILE); # Passing a filehandle to a subroutine

sub readit{
local(*myfile)=@_; # myfile is an alias for READMEFILE
    while(<myfile>){
	print;
    }
}
::::::::::::::
example18
::::::::::::::
#! /usr/bin/perl

# References And Type Glob
@list=(1, 2, 3, 4, 5);
$list="grocery";
*arr = \@list; # *arr is a reference only to the array @list
print @arr, "\n";
print "$arr\n"; # not a scalar reference

sub alias {
    local (*a) = @_; # Must use local, not my
    $a[0] = 7;
    pop @a;
}

&alias(*arr); # Call the subroutine
print "@list\n";
$num=5;
*scalar=\$num; # *scalar is a reference to the scalar $num
print "$scalar\n";
::::::::::::::
example19
::::::::::::::
#! /usr/bin/perl

$num=5;
$p = \$num; # the backslash operator means "adddress of"
print 'The address assigned $p is ', $p, "\n";
print "The value stored at that address is $$p\n";
::::::::::::::
example2
::::::::::::::
#! /usr/bin/perl

$name="Ellie";
print "Hello $name.\n";
bye(); # Without parens or an ampersand, bye would be a bare
# word causing a warning message when -w is used.
sub bye{
    print "Bye $name.\n";
}
::::::::::::::
example20
::::::::::::::
#! /usr/bin/perl

@toys = qw( Buzzlightyear Anakin Thomas Pokemon );
$num = @toys;
%movies=("Toy Story"=>"US",
	 "Thomas"=>"England",
	 "Pokemon"=>"Japan",
);

$ref1 = \$num; # scalar pointer
$ref2 = \@toys; # array pointer
$ref3= \%movies; # hash pointer
print "There are $$ref1 toys.\n"; # dereference pointers
print "They are: @$ref2.\n";
while( ($key, $value) = each ( %$ref3 )){
    print "$key--$value\n";
}
print "His favorite toys are $ref2->[0] and $ref2->[3].\n";
print "The Pokemon movie was made in $ref3->{Pokemon}.\n";
::::::::::::::
example21
::::::::::::::
#! /usr/bin/perl

# Hard References (Pointers)
# When assigning to a scalar, the backslash operator gets the
# address of the variable
@list=(1, 2, 3, 4, 5);
$name="Nicklas";
$ptr1 = \@list; # $ptr1 is assigned the address of @list
$ptr2 = \$name; # $ptr2 is assigned the address of $name
print q(The value of $ptr1 is: ), $ptr1, "\n";
print q(The array values $ptr1 is pointing at are:), "@$ptr1\n";
print q(The value of $ptr2 is: ), $ptr2, "\n";
print q(The scalar value $ptr2 is pointing to is: ),$$ptr2, "\n";
&fun($ptr1, $ptr2); # Call the subroutine ; pass pointers

sub fun {
    my ($arrayptr, $scalarptr) = @_; # Use my, not local
    print q(In subroutine: $arrayptr is: ), $arrayptr,"\n";
    print q(In subroutine: $scalarptr is:), $scalarptr, "\n";
    $arrayptr->[0] = 7; # Assign to the array with a pointer.
    pop @$arrayptr; # Pop the array
    $$scalarptr = "Andreas"; # Assign to the scalar with a pointer
    print "$$scalarptr @$arrayptr\n";
}

print "Out of subroutine.\n";
print "Now \@list is: @list\n";
print "Now \$name is $name\n";
::::::::::::::
example22
::::::::::::::
#! /usr/bin/perl

# This script demonstrates the use of hard references
# when passing arrays. Instead of passing the entire
# array, a hard reference (pointer) is passed.
# The value of the last expression is returned.
my @list1=(1 .. 100);
my @list2=(5, 10 , 15, 20);
print "The total is: ", &addemup( \@list1, \@list2) , ".\n"; # two pointers

sub addemup{
    my( $arr1, $arr2) = (shift, shift) ; # The two pointers are shifted from @_
    my $total = 0;
    print $arr1, "\n" ;
    print $arr2, "\n";
    foreach $num ( @$arr1 ){
	$total1+=$num;
    }
    foreach $num ( @$arr2) {
	$total2+=$num;
    }
    $total1 + $total2; # The expression is evaluated and returned
}
::::::::::::::
example23
::::::::::::::
#! /usr/bin/perl

sub AUTOLOAD {
    my(@arguments)=@_;
    $args=join(', ', @arguments);
    print "$AUTOLOAD was never defined.\n";
    print "The arguments passed were $args.\n";
}

$driver="Jody";
$miles=50;
$gallons=5;
&mileage($driver, $miles, $gallons); # Call to an undefined subroutine
::::::::::::::
example24
::::::::::::::
#! /usr/bin/perl

# Program to call a subroutine without defining it.
sub AUTOLOAD {
    my(@arguments) = @_;
    my($package, $command)=split("::",$AUTOLOAD, 2);
    return `$command @arguments`; # Command substitution
}

$day=date("+%D"); # date is an undefined subroutine
chomp $day;
print "Today is $day.\n";
print cal(3,2003); # cal is an undefined subroutine
::::::::::::::
example25
::::::::::::::
#! /usr/bin/perl
# Program to demonstrate BEGIN and END subroutines
chdir("/stuff") || die "Can't cd: $!\n";
BEGIN{ print "Welcome to my Program.\n"};
END{ print "Bailing out somewhere near line ",__LINE__, ". So long.\n"};
::::::::::::::
example26
::::::::::::::
#! /usr/bin/perl

# The subs module
use subs qw(fun1 fun2 );
fun1;
fun2;

sub fun1{
    print "In fun1\n";
}

sub fun2{
    print "In fun2\n";
}
::::::::::::::
example3
::::::::::::::
#! /usr/bin/perl

sub bye; # Forward reference
$name="Ellie";
print "Hello $name.\n";
bye; # Call subroutine without the ampersand

sub bye{
    print "Bye $name\n";
}
::::::::::::::
example4
::::::::::::::
#! /usr/bin/perl

# Script: perlsub_sub2
# Variables used in subroutines are global by default.
sub bye { print "Bye $name\n"; $name="Tom";}
# subroutine definition
$name="Ellie";
print "Hello to you and yours!\n";
&bye ;
print "Out of the subroutine. Hello $name.\n";
# $name is now Tom
&bye;
::::::::::::::
example5
::::::::::::::
#! /usr/bin/perl

# Passing arguments
$first="Charles";
$last="Dobbins";
&greeting ( $first, $last );
sub greeting{
print "@_", "\n";
print "Welcome to the club, $_[0] $_[1]!\n";
}
::::::::::::::
example6
::::::::::::::
#! /usr/bin/perl

# Program to demonstrate how @_ references values.
sub params{
    print 'The values in the @_ array are ', "@_\n";
    print "The first value is $_[0]\n";
    print "The last value is ", pop(@_),"\n";
    foreach $value ( @_ ) {
	$value+=5;
	print "The value is $value", "\n";
    }
}
print "Give me 5 numbers : ";
@n=split(' ',<STDIN>);
&params(@n);
print "Back in main\n";
print "The new values are @n \n";
::::::::::::::
example7
::::::::::::::
#! /usr/bin/perl

$first=Per;
$last=Lindberg;
&greeting ( $first, $last ) ; # Call the greeting subroutine
print "---$fname---\n" if defined $fname; # $fname is local to
# sub greeting.
# Subroutine defined
sub greeting{
local ($fname, $lname) = @_ ;
print "Welcome $fname!!\n";
}
::::::::::::::
example8
::::::::::::::
#! /usr/bin/perl

# The scope of my variables
my $name = "Raimo";
print "$name\n";
{ # Enter block
print "My name is $name\n";
my $name = "Elizabeth";
print "Now name is $name\n";
my $love = "Christina";
print "My love is $love.\n";
} # Exit block
print "$name is back.\n";
print "I can't see my love,$love, out here.\n";
::::::::::::::
example9
::::::::::::::
#! /usr/bin/perl

# Difference between my and local
$friend = Louise; # global variables
$pal = Danny;
print "$friend and $pal are global.\n";

sub guests {
    my $friend=Pat;
    local $pal=Chris;
    print "$friend and $pal are welcome guests.\n";
    &who_is_it; # call subroutine
}

sub who_is_it {
    print "You still have your global friend, $friend, here.\n";
    print "But your pal is now $pal.\n";
}

&guests; # call subroutine
print "Global friends are back: $friend and $pal.\n";
::::::::::::::
file1
::::::::::::::
Hello there. Nice day.
::::::::::::::
input16
::::::::::::::
1 2 3 4 5
::::::::::::::
input6
::::::::::::::
1 2 3 4 5
::::::::::::::
prototypes
::::::::::::::
#! /usr/bin/perl
# Program name:  prototypes
# Testing prototyping
my $a=5;
my $b=6;
my $c=7;
@list=(100,200,300);

sub myadd($$) { # myadd requires two scalar arguments
    my($x, $y)=@_;
    print $x + $y,"\n";
}

myadd($a, $b); # Ok
myadd(5, 4); # Ok
myadd($a, $b, $c); # Too many arguments