1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
#!/usr/bin/perl
# This adapted from the tutorial here:
# http://www.stonehenge.com/merlyn/LinuxMag/col94.html
# The Moose is Flying (part 1)'
# Using Mouse, instead
# use feature ':5.10';
use strict;
use warnings;
use Test::More;
# functions to capture the output of the tutorial
our $DUMMY_STDOUT = "";
sub dprint { $DUMMY_STDOUT .= join "", @_ };
sub stdout { my $stdout = $DUMMY_STDOUT; $DUMMY_STDOUT = ""; return $stdout }
sub say { ::dprint $_, "\n" for @_ }
######################################################################
# This is the tutorial, as posted by Heikki Lehvaslaiho in Mouse's RT
# ticket #42992, except with print and say modified to use the above.
package Animal;
use Mouse::Role;
has 'name' => (is => 'rw');
sub speak {
my $self = shift;
::dprint $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 {
::dprint "[but you can barely hear it!]\n";
};
before 'speak' => sub {
::dprint "[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;
######################################################################
# Now the tests
package main;
plan tests => 5;
#use Horse;
my $talking = Horse->new(name => 'Mr. Ed');
say $talking->name; # prints Mr. Ed
is stdout, "Mr. Ed\n";
$talking->color("grey"); # sets the color
$talking->speak; # says "Mr. Ed goes neigh"
is stdout, <<EXPECTED;
Mr. Ed goes neigh
EXPECTED
#use Sheep;
my $baab = Sheep->new(color => 'white', name => 'Baab');
$baab->speak; # prints "Baab goes baaaah"
is stdout, <<EXPECTED;
Baab goes baaaah
EXPECTED
#use MouseA
my $mickey = MouseA->new(name => 'Mickey');
$mickey->speak;
is stdout, <<EXPECTED;
[Ahem]
Mickey goes squeak
[but you can barely hear it!]
EXPECTED
#use RaceHorse;
my $s = RaceHorse->new(name => 'Seattle Slew');
$s->won; $s->won; $s->won; $s->placed; $s->lost; # run some races
::dprint $s->standings, "\n"; # 3 wins, 1 places, 0 shows, 1 losses
is stdout, <<EXPECTED;
3 wins, 1 places, 0 shows, 1 losses
EXPECTED
|
