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";