3 # This adapted from the tutorial here:
4 # http://www.stonehenge.com/merlyn/LinuxMag/col94.html
5 # The Moose is Flying (part 1)'
17 "This test requires Class::Method::Modifiers or Class::Method::Modifiers::Fast"
19 require Class::Method::Modifiers::Fast;
21 require Class::Method::Modifiers;
25 # functions to capture the output of the tutorial
26 our $DUMMY_STDOUT = "";
27 sub dprint { $DUMMY_STDOUT .= join "", @_ };
28 sub stdout { my $stdout = $DUMMY_STDOUT; $DUMMY_STDOUT = ""; return $stdout }
29 sub say { ::dprint $_, "\n" for @_ }
31 ######################################################################
32 # This is the tutorial, as posted by Heikki Lehvaslaiho in Mouse's RT
33 # ticket #42992, except with print and say modified to use the above.
37 has 'name' => (is => 'rw');
40 ::dprint $self->name, " goes ", $self->sound, "\n";
43 has 'color' => (is => 'rw', default => sub { shift->default_color });
44 requires 'default_color';
52 sub default_color { 'spotted' }
53 sub sound { 'moooooo' }
60 sub default_color { 'brown' }
68 sub default_color { 'black' }
69 sub sound { 'baaaah' }
76 sub default_color { 'white' }
77 sub sound { 'squeak' }
78 after 'speak' => sub {
79 ::dprint "[but you can barely hear it!]\n";
81 before 'speak' => sub {
91 has $_ => (is => 'rw', default => 0)
92 foreach qw(wins places shows losses);
93 sub won { my $self = shift; $self->wins($self->wins + 1) }
94 sub placed { my $self = shift; $self->places($self->places + 1) }
95 sub showed { my $self = shift; $self->shows($self->shows + 1) }
96 sub lost { my $self = shift; $self->losses($self->losses + 1) }
99 join ", ", map { $self->$_ . " $_" } qw(wins places shows losses);
106 # To create the race horse, we just mix a horse with a racer:
116 ######################################################################
122 my $talking = Horse->new(name => 'Mr. Ed');
123 say $talking->name; # prints Mr. Ed
124 is stdout, "Mr. Ed\n";
125 $talking->color("grey"); # sets the color
126 $talking->speak; # says "Mr. Ed goes neigh"
128 is stdout, <<EXPECTED;
134 my $baab = Sheep->new(color => 'white', name => 'Baab');
135 $baab->speak; # prints "Baab goes baaaah"
136 is stdout, <<EXPECTED;
141 my $mickey = MouseA->new(name => 'Mickey');
143 is stdout, <<EXPECTED;
146 [but you can barely hear it!]
150 my $s = RaceHorse->new(name => 'Seattle Slew');
151 $s->won; $s->won; $s->won; $s->placed; $s->lost; # run some races
152 ::dprint $s->standings, "\n"; # 3 wins, 1 places, 0 shows, 1 losses
153 is stdout, <<EXPECTED;
154 3 wins, 1 places, 0 shows, 1 losses