3 # This adapted from the tutorial here:
4 # http://www.stonehenge.com/merlyn/LinuxMag/col94.html
5 # The Moose is Flying (part 1)'
14 # functions to capture the output of the tutorial
15 our $DUMMY_STDOUT = "";
16 sub dprint { $DUMMY_STDOUT .= join "", @_ };
17 sub stdout { my $stdout = $DUMMY_STDOUT; $DUMMY_STDOUT = ""; return $stdout }
18 sub say { ::dprint $_, "\n" for @_ }
20 ######################################################################
21 # This is the tutorial, as posted by Heikki Lehvaslaiho in Mouse's RT
22 # ticket #42992, except with print and say modified to use the above.
26 has 'name' => (is => 'rw');
29 ::dprint $self->name, " goes ", $self->sound, "\n";
32 has 'color' => (is => 'rw', default => sub { shift->default_color });
33 requires 'default_color';
41 sub default_color { 'spotted' }
42 sub sound { 'moooooo' }
49 sub default_color { 'brown' }
57 sub default_color { 'black' }
58 sub sound { 'baaaah' }
65 sub default_color { 'white' }
66 sub sound { 'squeak' }
67 after 'speak' => sub {
68 ::dprint "[but you can barely hear it!]\n";
70 before 'speak' => sub {
80 has $_ => (is => 'rw', default => 0)
81 foreach qw(wins places shows losses);
82 sub won { my $self = shift; $self->wins($self->wins + 1) }
83 sub placed { my $self = shift; $self->places($self->places + 1) }
84 sub showed { my $self = shift; $self->shows($self->shows + 1) }
85 sub lost { my $self = shift; $self->losses($self->losses + 1) }
88 join ", ", map { $self->$_ . " $_" } qw(wins places shows losses);
95 # To create the race horse, we just mix a horse with a racer:
105 ######################################################################
108 use Test::More tests => 5;
111 my $talking = Horse->new(name => 'Mr. Ed');
112 say $talking->name; # prints Mr. Ed
113 is stdout, "Mr. Ed\n";
114 $talking->color("grey"); # sets the color
115 $talking->speak; # says "Mr. Ed goes neigh"
117 TODO: { local $TODO = "this currently fails because of a bug in Class::Method::Modifiers (see RT #42992)";
118 is stdout, <<EXPECTED;
124 my $baab = Sheep->new(color => 'white', name => 'Baab');
125 $baab->speak; # prints "Baab goes baaaah"
126 is stdout, <<EXPECTED;
132 my $mickey = MouseA->new(name => 'Mickey');
134 is stdout, <<EXPECTED;
137 [but you can barely hear it!]
141 my $s = RaceHorse->new(name => 'Seattle Slew');
142 $s->won; $s->won; $s->won; $s->placed; $s->lost; # run some races
143 ::dprint $s->standings, "\n"; # 3 wins, 1 places, 0 shows, 1 losses
144 is stdout, <<EXPECTED;
145 3 wins, 1 places, 0 shows, 1 losses