| Subject: | Method modifiers affect all classes in the whole inheritance tree |
| Date: | Tue, 3 Feb 2009 12:44:48 +0200 |
| To: | bug-Mouse [...] rt.cpan.org |
| From: | Heikki Lehvaslaiho <heikki.lehvaslaiho [...] gmail.com> |
This bug seems real enough for me.
I took Randal Schwartz's Moose tutorial from
http://www.stonehenge.com/merlyn/LinuxMag/col94.html and tried
everything in Mouse.
The 'after' (and 'before') method modifier is used in one of the
subclasses (MouseA) of Animal, but their under Mouse they effect is
visible in all subclasses (Horse, Sheep, MouseA,...). The same code
under Moose works as expected. The code is below.
--
-Heikki
Heikki Lehvaslaiho - heikki lehvaslaiho gmail com
--------------------------------------------------------------------------------------------------
#!/usr/bin/env perl
# http://www.stonehenge.com/merlyn/LinuxMag/col94.html
# The Mouse is Flying (part 1)'
# Using Mouse, instead
use feature ':5.10';
package Animal;
use Mouse::Role;
has 'name' => (is => 'rw');
sub speak {
my $self = shift;
print $self->name, " goes ", $self->sound, "\n";
}
requires 'sound';
has 'color' => (is => 'rw', default => sub { shift->default_color });
requires 'default_color';
no Mouse::Role;
1;
## Cow.pm:
package Cow;
use Mouse;
with 'Animal';
sub default_color { 'spotted' }
sub sound { 'moooooo' }
no Mouse;
1;
## Horse.pm:
package Horse;
use Mouse;
with 'Animal';
sub default_color { 'brown' }
sub sound { 'neigh' }
no Mouse;
1;
## Sheep.pm:
package Sheep;
use Mouse;
with 'Animal';
sub default_color { 'black' }
sub sound { 'baaaah' }
no Mouse;
1;
package MouseA;
use Mouse;
with 'Animal';
sub default_color { 'white' }
sub sound { 'squeak' }
after 'speak' => sub {
print "[but you can barely hear it!]\n";
};
before 'speak' => sub {
print "[Ahem]\n";
};
no Mouse;
1;
package Racer;
use Mouse::Role;
has $_ => (is => 'rw', default => 0)
foreach qw(wins places shows losses);
sub won { my $self = shift; $self->wins($self->wins + 1) }
sub placed { my $self = shift; $self->places($self->places + 1) }
sub showed { my $self = shift; $self->shows($self->shows + 1) }
sub lost { my $self = shift; $self->losses($self->losses + 1) }
sub standings {
my $self = shift;
join ", ", map { $self->$_ . " $_" } qw(wins places shows losses);
}
no Mouse::Role;
1;
# To create the race horse, we just mix a horse with a racer:
package RaceHorse;
use Mouse;
extends 'Horse';
with 'Racer';
no Mouse;
1;
package main;
#use Horse;
my $talking = Horse->new(name => 'Mr. Ed');
say $talking->name; # prints Mr. Ed
$talking->color("grey"); # sets the color
$talking->speak; # says "Mr. Ed goes neigh"
#use Sheep;
my $baab = Sheep->new(color => 'white', name => 'Baab');
$baab->speak; # prints "Baab goes baaaah"
#use MouseA
my $mickey = MouseA->new(name => 'Mickey');
$mickey->speak;
#use RaceHorse;
my $s = RaceHorse->new(name => 'Seattle Slew');
$s->won; $s->won; $s->won; $s->placed; $s->lost; # run some races
print $s->standings, "\n"; # 3 wins, 1 places, 0 shows, 1 losses
--------------------------------------------------------------------------------------------------