peers method
called on an employee to act a bit differently. Instead of just returning
the list of peer names, let's return slightly different strings. So doing
this:
$empl->peers("Peter", "Paul", "Mary");
printf "His peers are: %s\n", join(", ", $empl->peers);
will produce:
His peers are: PEON=PETER, PEON=PAUL, PEON=MARY
To do this, merely add this definition into the Employee.pm file:
sub peers {
my $self = shift;
if (@_) { @{ $self->{PEERS} } = @_ }
return map { "PEON=\U$_" } @{ $self->{PEERS} };
}
There, we've just demonstrated the high-falutin' concept known in certain circles as polymorphism. We've taken on the form and behaviour of an existing object, and then we've altered it to suit our own purposes. This is a form of Laziness. (Getting polymorphed is also what happens when the wizard decides you'd look better as a frog.)
Every now and then you'll want to have a method call trigger both its
derived class (also know as ``subclass'') version as well as its base class
(also known as ``superclass'') version. In practice, constructors and
destructors are likely to want to do this, and it probably also makes sense
in the debug method we showed previously.
To do this, add this to Employee.pm:
use Carp;
my $Debugging = 0;
sub debug {
my $self = shift;
confess "usage: thing->debug(level)" unless @_ == 1;
my $level = shift;
if (ref($self)) {
$self->{"_DEBUG"} = $level;
} else {
$Debugging = $level; # whole class
}
Person::debug($self, $Debugging); # don't really do this
}
As you see, we turn around and call the Person package's debug
function. But this is far too fragile for good design. What if Person
doesn't have a debug function, but is inheriting its debug method from elsewhere? It would have been slightly
better to say
Person->debug($Debugging);
But even that's got too much hard-coded. It's somewhat better to say
$self->Person::debug($Debugging);
Which is a funny way to say to start looking for a debug
method up in Person. This strategy is more often seen on overridden object
methods than on overridden class methods.
There is still something a bit off here. We've hard-coded our superclass's name. This in particular is bad if you change which classes you inherit from, or add others. Fortunately, the pseudoclass SUPER comes to the rescue here.
$self->SUPER::debug($Debugging);
This way it starts looking in my class's @ISA. This only makes sense from within a method call, though. Don't try to access anything in SUPER:: from anywhere else, because it doesn't exist outside an overridden method call.
Things are getting a bit complicated here. Have we done anything we shouldn't? As before, one way to test whether we're designing a decent class is via the empty subclass test. Since we already have an Employee class that we're trying to check, we'd better get a new empty subclass that can derive from Employee. Here's one:
package Boss;
use Employee; # :-)
@ISA = qw(Employee);
And here's the test program:
#!/usr/bin/perl -w
use strict;
use Boss;
Boss->debug(1);
my $boss = Boss->new();
$boss->fullname->title("Don");
$boss->fullname->surname("Pichon Alvarez");
$boss->fullname->christian("Federico Jesus");
$boss->fullname->nickname("Fred");
$boss->age(47);
$boss->peers("Frank", "Felipe", "Faust");
printf "%s is age %d.\n", $boss->fullname, $boss->age;
printf "His peers are: %s\n", join(", ", $boss->peers);
Running it, we see that we're still ok. If you'd like to dump out your object in a nice format, somewhat like the way the 'x' command works in the debugger, you could use the Data::Dumper module from CPAN this way:
use Data::Dumper;
print "Here's the boss:\n";
print Dumper($boss);
Which shows us something like this:
Here's the boss:
$VAR1 = bless( {
_CENSUS => \1,
FULLNAME => bless( {
TITLE => 'Don',
SURNAME => 'Pichon Alvarez',
NICK => 'Fred',
CHRISTIAN => 'Federico Jesus'
}, 'Fullname' ),
AGE => 47,
PEERS => [
'Frank',
'Felipe',
'Faust'
]
}, 'Boss' );
Hm.... something's missing there. What about the salary, start date, and
ID fields? Well, we never set them to anything, even undef, so they don't show up in the hash's keys. The Employee class has no new method of its own, and the new method in Person doesn't know about Employees. (Nor should it: proper
OO design dictates that a subclass be allowed to know about its immediate superclass, but never vice-versa.) So let's fix up Employee::new() this way:
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = $class->SUPER::new();
$self->{SALARY} = undef;
$self->{ID} = undef;
$self->{START_DATE} = undef;
bless ($self, $class); # reconsecrate
return $self;
}
Now if you dump out an Employee or Boss object, you'll find that new fields show up there now.