employee.pm

perl learn perl by examples

#---------------------------------------------------------------------------
package Employee;
#---------------------------------------------------------------------------
# This package uses the ObjectTemplate package to declare an Employee object
# 
# 
# It consists
use ObjectTemplate;
@ISA = qw(ObjectTemplate);
attributes qw(name age);

sub print {
    my $obj = $_[0];
    print "Employee[$$obj] ...  Free index: $_free\n";
    print "\tName   => ", $obj->name  ,"\n";
    print "\tAge    => ", $obj->age   ,"\n";
}

sub name {
    # Example of a custom accessor function
    # Allows the name attribute to be set only once
    my $obj = shift;
    my $name = $obj->get_attribute("name");
    
    if (@_) {
       if ($name) {
          die "Cannot update name \n";
       } else {
          $obj->set_attribute("name", $_[0]);
       }
    }
    $name;
}

#-----------------------------------------------------------------------
# Sample inherited Class
#-----------------------------------------------------------------------

package HourlyEmployee;
@ISA = qw (Employee);
use ObjectTemplate;
attributes qw(wage);


#-----------------------------------------------------------------------
# TESTING CODE
#    Simply invoke as "perl Employee.pm"
#-----------------------------------------------------------------------

if (! caller()) {
    
    package main;
    #-----------------------------------------------------------
    # Check create
    $e1 = Employee->new(name => 'test1', age  => 43);
    $e2 = Employee->new(name => 'test2', age  => 50);
    if ($e1->name ne 'test1' || $e2->age != 50) {
        print "ERROR. Accessors not working\n";
    } else {
        print "OK. Accessors working\n";
    }    

    #-----------------------------------------------------------
    # Check that deleting one object doesn't mess the other
    undef $e1;
    
    if ($e2->name ne 'test2' || $e2->age != 50) {
        print "ERROR ... Delete messing up other objects\n";
    } else {
        print "OK. Delete doesn't affect other objects\n";
    }

    #-----------------------------------------------------------
    # Check creation of object after delete
    $e1 = Employee->new(name => 'test1', age  => 43);
    if ($e1->name ne 'test1' || $e2->age != 50) {
        print "ERROR .... Object not created correctly after delete\n";
    } else {
        print "OK. Object created correctly after delete\n";
    }

    #-----------------------------------------------------------
    # Check if custom accessor called
    eval {$e1->name("foo")};
    if ($@ !~ /Cannot update name/) {
        print "ERROR. Custom accessor not called\n";
    } else {
        print "OK. Custom accessor called\n";
    }

    #-----------------------------------------------------------
    # Check if inherited properly
    $e2 = HourlyEmployee->new(name => 'Joe', age => 47, wage => 40);
    if ($e2->name ne 'Joe' || $e2->age != 47) {
        print "ERROR. Accessors of inherited classes not working\n";
    } else {
        print "OK. Accessors of inherited classes working\n";
    }    
    
    eval {$e2->name("foo")};
    if ($@ !~ /Cannot update name/) {
        print "ERROR. Inherited custom accessor not called\n";
    } else {
        print "OK. Inherited custom accessor works\n";
    }

   
}
1;