an entire pasture:
# Cow::speak, Horse::speak, Sheep::speak as before
- my @pasture = qw(Cow Cow Horse Sheep Sheep);
- foreach my $animal (@pasture) {
+ @pasture = qw(Cow Cow Horse Sheep Sheep);
+ foreach $animal (@pasture) {
&{$animal."::speak"};
}
a Sheep goes baaaah!
Wow. That symbolic coderef de-referencing there is pretty nasty.
-We're counting on L<strict|C<no strict refs>> mode, certainly not
-recommended for larger programs. And why was that necessary? Because
-the name of the package seems to be inseparable from the name of the
-subroutine we want to invoke within that package.
+We're counting on C<no strict subs> mode, certainly not recommended
+for larger programs. And why was that necessary? Because the name of
+the package seems to be inseparable from the name of the subroutine we
+want to invoke within that package.
Or is it?
That's not fun yet. Same number of characters, all constant, no
variables. But yet, the parts are separable now. Watch:
- my $a = "Cow";
+ $a = "Cow";
$a->speak; # invokes Cow->speak
Ahh! Now that the package name has been parted from the subroutine
name, we can use a variable package name. And this time, we've got
-something that works even when L<strict|C<use strict refs>> is
-enabled.
+something that works even when C<use strict refs> is enabled.
=head2 Invoking a barnyard
print "a Sheep goes baaaah!\n"
}
- my @pasture = qw(Cow Cow Horse Sheep Sheep);
- foreach my $animal (@pasture) {
+ @pasture = qw(Cow Cow Horse Sheep Sheep);
+ foreach $animal (@pasture) {
$animal->speak;
}
Let's call out from C<speak> to a helper method called C<sound>.
This method provides the constant text for the sound itself.
- {
- package Cow;
-
+ { package Cow;
sub sound { "moooo" }
-
sub speak {
- my $class = shift;
- print "a $class goes ", $class->sound, "!\n"
+ my $class = shift;
+ print "a $class goes ", $class->sound, "!\n"
}
}
C<speak>. This in turn selects the C<< Cow->sound >> method, which
returns C<moooo>. But how different would this be for the C<Horse>?
- {
- package Horse;
-
+ { package Horse;
sub sound { "neigh" }
-
sub speak {
my $class = shift;
print "a $class goes ", $class->sound, "!\n"
We'll define a common subroutine package called C<Animal>, with the
definition for C<speak>:
- {
- package Animal;
-
+ { package Animal;
sub speak {
my $class = shift;
print "a $class goes ", $class->sound, "!\n"
Then, for each animal, we say it "inherits" from C<Animal>, along
with the animal-specific sound:
- {
- package Cow;
-
- # Not safe under `use strict', see below
+ { package Cow;
@ISA = qw(Animal);
-
sub sound { "moooo" }
}
Or allow it as an implicitly named package variable:
package Cow;
- our @ISA = qw(Animal);
+ use vars qw(@ISA);
+ @ISA = qw(Animal);
If you're bringing in the class from outside, via an object-oriented
module, you change:
package Cow;
use Animal;
- our @ISA = qw(Animal);
+ use vars qw(@ISA);
+ @ISA = qw(Animal);
into just:
package Cow;
use base qw(Animal);
-And that's pretty darn compact. Read about the L<base|base> pragma.
+And that's pretty darn compact.
=head2 Overriding the methods
Let's add a mouse, which can barely be heard:
- # Animal package that we wrote before, goes here
- {
- package Mouse;
-
- our @ISA = qw(Animal);
-
+ # Animal package from before
+ { package Mouse;
+ @ISA = qw(Animal);
sub sound { "squeak" }
-
sub speak {
my $class = shift;
print "a $class goes ", $class->sound, "!\n";
First, we can invoke the C<Animal::speak> method directly:
- # Animal package that we wrote before, goes here
- {
- package Mouse;
-
- our @ISA = qw(Animal);
-
+ # Animal package from before
+ { package Mouse;
+ @ISA = qw(Animal);
sub sound { "squeak" }
-
sub speak {
my $class = shift;
Animal::speak($class);
in the inheritance chain:
# same Animal as before
- {
- package Mouse;
-
+ { package Mouse;
# same @ISA, &sound as before
-
sub speak {
my $class = shift;
$class->Animal::speak;
listed in C<@ISA>) automatically:
# same Animal as before
- {
- package Mouse;
-
+ { package Mouse;
# same @ISA, &sound as before
-
sub speak {
my $class = shift;
$class->SUPER::speak;
}
So, C<SUPER::speak> means look in the current package's C<@ISA> for
-C<speak>, invoking the first one found.
+C<speak>, invoking the first one found. Note that it does I<not> look in
+the C<@ISA> of C<$class>.
=head2 Where we're at so far...
or the equivalent:
- my $a = "Class";
+ $a = "Class";
$a->method(@args);
which constructs an argument list of:
Let's start with the code for the C<Animal> class
and the C<Horse> class:
- {
- package Animal;
-
+ { package Animal;
sub speak {
my $class = shift;
print "a $class goes ", $class->sound, "!\n"
}
}
-
- {
- package Horse;
-
- our @ISA = qw(Animal);
-
+ { package Horse;
+ @ISA = qw(Animal);
sub sound { "neigh" }
}
can be an instance, so let's start with the simplest reference
that can hold a horse's name: a scalar reference.
- my $name = "Mr. Ed";
+ my $name = "Mr. Ed";
my $talking = \$name;
So now C<$talking> is a reference to what will be the instance-specific
the instance-specific data. In this case, let's add a way to get at
the name:
- {
- package Horse;
-
- our @ISA = qw(Animal);
-
+ { package Horse;
+ @ISA = qw(Animal);
sub sound { "neigh" }
-
sub name {
my $self = shift;
$$self;
but not if you just like to own horses. So, let's let the Horse class
build a new horse:
- {
- package Horse;
-
- our @ISA = qw(Animal);
-
+ { package Horse;
+ @ISA = qw(Animal);
sub sound { "neigh" }
-
sub name {
my $self = shift;
$$self;
}
-
sub named {
my $class = shift;
- my $name = shift;
+ my $name = shift;
bless \$name, $class;
}
}
it's also the same recipe for building anything else that inherited from
C<Animal>, so let's put it there:
- {
- package Animal;
-
+ { package Animal;
sub speak {
my $class = shift;
print "a $class goes ", $class->sound, "!\n"
}
-
sub name {
my $self = shift;
$$self;
}
-
sub named {
my $class = shift;
- my $name = shift;
+ my $name = shift;
bless \$name, $class;
}
}
-
- {
- package Horse;
-
- our @ISA = qw(Animal);
-
+ { package Horse;
+ @ISA = qw(Animal);
sub sound { "neigh" }
}
sub name {
my $either = shift;
ref $either
- ? $$either # it's an instance, return name
+ ? $$either # it's an instance, return name
: "an unnamed $either"; # it's a class, return generic
}
holder to C<$either> to show that this is intended:
my $talking = Horse->named("Mr. Ed");
-
- print Horse->name, "\n"; # prints "an unnamed Horse\n"
+ print Horse->name, "\n"; # prints "an unnamed Horse\n"
print $talking->name, "\n"; # prints "Mr Ed.\n"
and now we'll fix C<speak> to use this:
Let's train our animals to eat:
- {
- package Animal;
+ { package Animal;
sub named {
my $class = shift;
- my $name = shift;
+ my $name = shift;
bless \$name, $class;
}
-
sub name {
my $either = shift;
ref $either
- ? $$either # it's an instance, return name
+ ? $$either # it's an instance, return name
: "an unnamed $either"; # it's a class, return generic
}
-
sub speak {
my $either = shift;
print $either->name, " goes ", $either->sound, "\n";
}
-
sub eat {
my $either = shift;
- my $food = shift;
+ my $food = shift;
print $either->name, " eats $food.\n";
}
}
-
- {
- package Horse;
-
- our @ISA = qw(Animal);
-
+ { package Horse;
+ @ISA = qw(Animal);
sub sound { "neigh" }
}
-
- {
- package Sheep;
-
- our @ISA = qw(Animal);
-
+ { package Sheep;
+ @ISA = qw(Animal);
sub sound { "baaaah" }
}
my $talking = Horse->named("Mr. Ed");
$talking->eat("hay");
-
Sheep->eat("grass");
which prints:
Let's make a sheep that has a name and a color:
- my $data = { Name => "Evil", Color => "black" };
- my $bad = bless $data, Sheep;
+ my $bad = bless { Name => "Evil", Color => "black" }, Sheep;
so C<< $bad->{Name} >> has C<Evil>, and C<< $bad->{Color} >> has
C<black>. But we want to make C<< $bad->name >> access the name, and
## in Animal
sub named {
my $class = shift;
- my $name = shift;
- my $self = { Name => $name, Color => $class->default_color };
-
+ my $name = shift;
+ my $self = { Name => $name, Color => $class->default_color };
bless $self, $class;
}
sub color {
$_[0]->{Color}
}
-
sub set_color {
$_[0]->{Color} = $_[1];
}
https://perl5.git.perl.org / perl5.git / blobdiff