Perl Cd Bookshelf [Electronic resources] نسخه متنی

A.8. Answer for Chapter 9

First, start the Animal package:

use strict;
{ package Animal;
use Carp qw(croak);

And now for the constructor:

## constructors
sub named {
ref(my $class = shift) and croak "class name needed";
my $name = shift;
my $self = { Name => $name, Color => $class->default_color };
bless $self, $class;
}

Now, for virtual methods: the methods that
should be overridden in a subclass. Perl doesn''t
require virtual methods to be declared in the base class, but
it''s nice as a documentation item.

## backstops (should be overridden)
sub default_color { "brown" }
sub sound { croak "subclass must define a sound" }

Next comes the methods that work with either a class or an instance:

## class/instance methods
sub speak {
my $either = shift;
print $either->name, " goes ", $either->sound, "\n";
}
sub name {
my $either = shift;
ref $either
? $either->{Name}
: "an unnamed $either";
}
sub color {
my $either = shift;
ref $either
? $either->{Color}
: $either->default_color;
}

Finally, the methods that work only for the particular instance:

## instance-only methods
sub set_name {
ref(my $self = shift) or croak "instance variable needed";
$self->{Name} = shift;
}
sub set_color {
ref(my $self = shift) or croak "instance variable needed";
$self->{Color} = shift;
}
}

Now that you have your abstract base class, define some concrete
classes that can have instances:

{ package Horse;
our @ISA = qw(Animal);
sub sound { "neigh" }
}
{ package Sheep;
our @ISA = qw(Animal);
sub color { "white" }    # override the default color
sub sound { "baaaah" }   # no Silence of the Lambs
}

Finally, a few lines of code to test your classes:

my $tv_horse = Horse->named("Mr. Ed");
$tv_horse->set_name("Mister Ed");
$tv_horse->set_color("grey");
print $tv_horse->name, " is ", $tv_horse->color, "\n";
print Sheep->name, " colored ", Sheep->color, " goes ", Sheep->sound, "\n";