#!/usr/bin/perl -w

####################  Demonstrating Object-Oriented Perl  ####################

use lib(".");   #  Look for Person/Employee modules in current directory.
use Person;     #  Capital letter prevents compiler warning!
use Employee;

$me  = Person->new("John Perry", "47", 10.00);

print $me->name()," ", $me->age(),"\n";
$you = $me->new();  #  Clone of myself!!

print $me->name()," ", $you->name(),"\n";
$me->name("Joe Doinck");  #  Change my name!
print $me->name()," ", $you->name(),"\n";  #  You and me now different??

$another = $me;
$me->name("Frank Discussion");  #  Change my name!
print $me->name()," ", $another->name(),"\n";  # Me and another now different??

#  Two new Employees
$john = Employee->new("John Doe", "5", 44444.44);
$mike = Employee->new("Mike Rophone", "3", 50000.00);

#  Use accessor functions to access John's attributes.
print $john->name()," ",$john->age()," ",$john->salary(),"\n";

$mike->name("Mike Hammer");  #  Change Mike's name.  See if change worked.
print $mike->name(),"\n";

#  See what staffsize is after first two Employees are hired!
print Employee->staffsize(),"\n";

undef $john;   #  Implicit call to DESTROY function in Employee. 
print Employee->staffsize(),"\n";   #  Did staff size get lowered?
##########################  Program Output Below ############################

John Perry 47            # Result of calls to $john->name() and $john->age().
John Perry John Perry    # $me->name() and $you->name() after $you = $me->new()
Joe Doinck John Perry    # Changed $me->{NAME}.  $you->{NAME} unchanged.
Frank Discussion Frank Discussion  #  Changed $me->{NAME} and therefore
                                   #  Changed $another->{NAME} because 
                                   #  $another = $me is NOT cloning!!!

Doe,John 5 44444.44      # Dump of $john fields (name, age, salary)
Hammer,Mike              # Changed name of $mike.  It worked!
2                        # Staff size after two new Employees
1                        # Staff size after Employee $john is undef'ed



package Person;    #  Person object constructors and methods.  Must be
                   #  in file Person.pm.  Note: No use Exporter or @EXPORT.
sub new
{
    my $type = shift;  #  Allows inheritance
    my ($self, $other) = ({}, {});  # Inits. are cosmetic -- not required.
    
    if (@_)  #  If I have args then assign object.
    {
        $self->{NAME} =  $_[0];
        $self->{AGE}  =  $_[1];
        bless $self, $type;   #  Type may not be Person due to inheritance!!
    }
    elsif (ref $type)  #  If I passed an object ref, clone existing object!
    {
        $other->{NAME} = $type->{NAME};  # $type is NOT a class name!
        $other->{AGE}  = $type->{AGE};   # It's an object *reference* !!
        bless $other, 'Person';
    }
    else  # Construct a new, unassigned object.  Assumes $type is a class name.
    {
        $self->{NAME} = $self->{AGE};
        bless $self, $type;
    }
    return ref($type) ? $other : $self;  #  If $type is a ref, pass back
                                         #  cloned object.  If $type is
                                         #  a class name, pass back constructed
                                         #  new object.
}

#  Accessor/mutator functions to get at object parts.
sub name 
{
     my $self = shift;

     #  If I gave an argument, assign new name to Person object.  Otherwise,
     #  simply tell user of this sub what the name is.
     if (@_) {$self->{NAME} = shift}
     return $self->{NAME};
}


sub age
{
     my $self = shift;

     if (@_) {$self->{AGE} = shift}
     return $self->{AGE}; 
}
1;  #  Required in object modules, too!
#######################  End of Person Object Module  ########################




package Employee;

@ISA = qw(Person);  #  @ISA contains base class names.

my $staffSize = 0;  #  A class (static) variable.

sub new
{
    my $type = shift;  
    my $self = {};
 
    $self = $type->SUPER::new($_[0], $_[1]);  #  Not $self->Person->new()!! 
    $self->{SALARY} = $_[2];
    $staffSize++;   #  Not $self->$staffSize++!  $StaffSize is a CLASS 
                    #  variable and NOT an object variable!
    return $self; 
}


#  Accessor/mutator functions to get at object parts.
#  Subs name and age inherited from Person object. 

sub name  # Overrides Person's name function.  Gives name as "last,first" 
{
     my $self = shift;

     if (@_) {$self->{NAME} = shift}
     else {$self->{NAME} = join(",", (split /\s+/, $self->{NAME})[1,0])} 
     return $self->{NAME}; 
}



sub salary   #  New method.  Not inherited from Person object. 
{
     my $self = shift;

     if (@_) {$self->{SALARY} = shift}
     return $self->{SALARY}; 
}


sub staffsize   #  Accesses class (static) variable.
{
     return $staffSize;
}


sub DESTROY     #  Staff size lowered when Employee object is destroyed.
{
     $staffSize--;
}
1;   #  Must always be here!!
#!/usr/bin/perl -w

###########  A timing package.

use lib(".");
use Timer;

$timer = Timer->new();
print $timer->elapsed(),"\n";

for ($i = 0; $i < 1000000; $i++) {}
print $timer->elapsed(),"\n";

for ($i = 0; $i < 500000; $i++) {}
print $timer->elapsed(),"\n";
##############################  Program Output  #########################
0
5
6
################################  Timer.pm  #############################

package Timer;

sub new
{
    my ($class) = shift;
    my ($self);

    $$self = time();
    return bless $self, $class;
}


sub elapsed
{
    my ($self) = shift;

    return time - $$self;
}
1;
##########################################################################

#!/usr/bin/perl -w

use lib(".");
use Array;     ##  A very simple array package.

@list = (1,2,3,4,5);
$aref = Array->new(@list);
print $aref->average();
################################  Program Output  ########################
3
###################################  Array.pm  ###########################
package Array;

sub new
{
    my ($type, @list) = @_;
    
    $self = [@list]; 
    return bless $self, $type;
}


sub average
{
    my ($self) = shift;
    my ($sum, $num);

    $sum = 0;
    foreach $num (@$self)
    {
        $sum += $num;
    }
    return $sum/@$self if @$self;
    return -1;
}
1;    
#########################################################################
#!/usr/bin/perl -w

use lib(".");
use Matrix;     #######   A Matrix package.

$ror = [[2,4,6], [7,6,5], [9,1,2], [8,4,3]];

$matrix = Matrix->new($ror);
$matrix->dump;

$copy = $matrix->new();
$copy->dump;

$matrix->ChangeRow(0, [1,3,5]);
$matrix->dump;

$copy->dump;

$trans = $matrix->transpose;
$trans->dump;
###############################  Program Output  #########################

2 4 6
7 6 5
9 1 2
8 4 3

2 4 6   #  The copy before the original was changed.
7 6 5
9 1 2
8 4 3

1 3 5   #  The original matrix with row 0 changed.
7 6 5
9 1 2
8 4 3

2 4 6   #  The copy AFTER the original was changed -- proof of deep copy!!
7 6 5
9 1 2
8 4 3

1 7 9 8   #  Transpose of the original matrix after row 0 was changed.
3 6 1 4
5 5 2 3

################################  Matrix.pm  #############################

package Matrix;

sub new
{
   my ($type) = shift;
   my ($self, $other);

   if (ref $type)
   {
       for ($i = 0; $i < @$type; $i++) {
            for ($j = 0; $j < @{$type->[$i]}; $j++)
            {
                 $other->[$i][$j] = $type->[$i][$j];
            }
       }
       return bless $other, 'Matrix';
   }
   elsif (@_)   #  Got a matrix reference.  Do a deep copy!
   {
       for ($i = 0; $i < @{$_[0]}; $i++) {
            for ($j = 0; $j < @{$_[0]->[$i]}; $j++)
            {
                 $self->[$i][$j] = $_[0]->[$i][$j];
            }
       }
       return bless $self, $type;
   }   
   else {return bless [], $type;}
}



sub dump
{
     my ($self) = shift;

     foreach $rowref (@$self)
     {
          print "@$rowref\n";
     }
     print "\n";
}



sub ChangeRow
{
    my ($self, $rownum, $rowref) = @_;

    $self->[$rownum] = [@$rowref];  #  Deep copy!
}



1;