Commit | Line | Data |
daa0fd7d |
1 | package Moose::Cookbook::Roles::Recipe1; |
a7d0cd00 |
2 | |
daa0fd7d |
3 | # ABSTRACT: The Moose::Role example |
4 | |
5 | __END__ |
a7d0cd00 |
6 | |
a7d0cd00 |
7 | |
daa0fd7d |
8 | =pod |
a7d0cd00 |
9 | |
10 | =head1 SYNOPSIS |
9e93dd19 |
11 | |
446e850f |
12 | package Eq; |
a7d0cd00 |
13 | use Moose::Role; |
a39ea7dc |
14 | |
446e850f |
15 | requires 'equal_to'; |
a39ea7dc |
16 | |
17 | sub not_equal_to { |
18 | my ( $self, $other ) = @_; |
9e93dd19 |
19 | not $self->equal_to($other); |
a7d0cd00 |
20 | } |
a39ea7dc |
21 | |
9e93dd19 |
22 | package Comparable; |
a7d0cd00 |
23 | use Moose::Role; |
a39ea7dc |
24 | |
446e850f |
25 | with 'Eq'; |
a39ea7dc |
26 | |
446e850f |
27 | requires 'compare'; |
a39ea7dc |
28 | |
446e850f |
29 | sub equal_to { |
a39ea7dc |
30 | my ( $self, $other ) = @_; |
446e850f |
31 | $self->compare($other) == 0; |
a39ea7dc |
32 | } |
33 | |
446e850f |
34 | sub greater_than { |
a39ea7dc |
35 | my ( $self, $other ) = @_; |
446e850f |
36 | $self->compare($other) == 1; |
a39ea7dc |
37 | } |
38 | |
446e850f |
39 | sub less_than { |
a39ea7dc |
40 | my ( $self, $other ) = @_; |
446e850f |
41 | $self->compare($other) == -1; |
a7d0cd00 |
42 | } |
a39ea7dc |
43 | |
446e850f |
44 | sub greater_than_or_equal_to { |
a39ea7dc |
45 | my ( $self, $other ) = @_; |
446e850f |
46 | $self->greater_than($other) || $self->equal_to($other); |
a39ea7dc |
47 | } |
48 | |
446e850f |
49 | sub less_than_or_equal_to { |
a39ea7dc |
50 | my ( $self, $other ) = @_; |
446e850f |
51 | $self->less_than($other) || $self->equal_to($other); |
a39ea7dc |
52 | } |
53 | |
9e93dd19 |
54 | package Printable; |
9e93dd19 |
55 | use Moose::Role; |
a39ea7dc |
56 | |
57 | requires 'to_string'; |
58 | |
446e850f |
59 | package US::Currency; |
a7d0cd00 |
60 | use Moose; |
a39ea7dc |
61 | |
9e93dd19 |
62 | with 'Comparable', 'Printable'; |
a39ea7dc |
63 | |
64 | has 'amount' => ( is => 'rw', isa => 'Num', default => 0 ); |
65 | |
446e850f |
66 | sub compare { |
a39ea7dc |
67 | my ( $self, $other ) = @_; |
446e850f |
68 | $self->amount <=> $other->amount; |
69 | } |
a39ea7dc |
70 | |
9e93dd19 |
71 | sub to_string { |
72 | my $self = shift; |
a39ea7dc |
73 | sprintf '$%0.2f USD' => $self->amount; |
9e93dd19 |
74 | } |
cb26ee7e |
75 | |
a7d0cd00 |
76 | =head1 DESCRIPTION |
77 | |
efaf28e9 |
78 | Roles have two primary purposes: as interfaces, and as a means of code |
79 | reuse. This recipe demonstrates the latter, with roles that define |
80 | comparison and display code for objects. |
cb26ee7e |
81 | |
19320607 |
82 | Let's start with C<Eq>. First, note that we've replaced C<use Moose> |
695a3797 |
83 | with C<use Moose::Role>. We also have a new sugar function, C<requires>: |
cb26ee7e |
84 | |
85 | requires 'equal_to'; |
86 | |
efaf28e9 |
87 | This says that any class which consumes this role must provide an |
88 | C<equal_to> method. It can provide this method directly, or by |
89 | consuming some other role. |
cb26ee7e |
90 | |
efaf28e9 |
91 | The C<Eq> role defines its C<not_equal_to> method in terms of the |
92 | required C<equal_to> method. This lets us minimize the methods that |
93 | consuming classes must provide. |
cb26ee7e |
94 | |
efaf28e9 |
95 | The next role, C<Comparable>, builds on the C<Eq> role. We include |
96 | C<Eq> in C<Comparable> using C<with>, another new sugar function: |
cb26ee7e |
97 | |
98 | with 'Eq'; |
99 | |
efaf28e9 |
100 | The C<with> function takes a list of roles to consume. In our example, |
101 | the C<Comparable> role provides the C<equal_to> method required by |
102 | C<Eq>. However, it could opt not to, in which case a class that |
103 | consumed C<Comparable> would have to provide its own C<equal_to>. In |
104 | other words, a role can consume another role I<without> providing any |
105 | required methods. |
cb26ee7e |
106 | |
efaf28e9 |
107 | The C<Comparable> role requires a method, C<compare>: |
cb26ee7e |
108 | |
109 | requires 'compare'; |
110 | |
efaf28e9 |
111 | The C<Comparable> role also provides a number of other methods, all of |
112 | which ultimately rely on C<compare>. |
cb26ee7e |
113 | |
114 | sub equal_to { |
a39ea7dc |
115 | my ( $self, $other ) = @_; |
cb26ee7e |
116 | $self->compare($other) == 0; |
117 | } |
a39ea7dc |
118 | |
cb26ee7e |
119 | sub greater_than { |
a39ea7dc |
120 | my ( $self, $other ) = @_; |
cb26ee7e |
121 | $self->compare($other) == 1; |
a39ea7dc |
122 | } |
123 | |
cb26ee7e |
124 | sub less_than { |
a39ea7dc |
125 | my ( $self, $other ) = @_; |
cb26ee7e |
126 | $self->compare($other) == -1; |
127 | } |
a39ea7dc |
128 | |
cb26ee7e |
129 | sub greater_than_or_equal_to { |
a39ea7dc |
130 | my ( $self, $other ) = @_; |
cb26ee7e |
131 | $self->greater_than($other) || $self->equal_to($other); |
a39ea7dc |
132 | } |
133 | |
cb26ee7e |
134 | sub less_than_or_equal_to { |
a39ea7dc |
135 | my ( $self, $other ) = @_; |
cb26ee7e |
136 | $self->less_than($other) || $self->equal_to($other); |
137 | } |
138 | |
d0049458 |
139 | Finally, we define the C<Printable> role. This role exists solely to |
140 | provide an interface. It has no methods, just a list of required methods. |
141 | In this case, it just requires a C<to_string> method. |
cb26ee7e |
142 | |
efaf28e9 |
143 | An interface role is useful because it defines both a method and a |
144 | I<name>. We know that any class which does this role has a |
145 | C<to_string> method, but we can also assume that this method has the |
146 | semantics we want. Presumably, in real code we would define those |
147 | semantics in the documentation for the C<Printable> role. (1) |
148 | |
149 | Finally, we have the C<US::Currency> class which consumes both the |
150 | C<Comparable> and C<Printable> roles. |
cb26ee7e |
151 | |
152 | with 'Comparable', 'Printable'; |
153 | |
efaf28e9 |
154 | It also defines a regular Moose attribute, C<amount>: |
cb26ee7e |
155 | |
a39ea7dc |
156 | has 'amount' => ( is => 'rw', isa => 'Num', default => 0 ); |
cb26ee7e |
157 | |
efaf28e9 |
158 | Finally we see the implementation of the methods required by our |
159 | roles. We have a C<compare> method: |
cb26ee7e |
160 | |
161 | sub compare { |
a39ea7dc |
162 | my ( $self, $other ) = @_; |
cb26ee7e |
163 | $self->amount <=> $other->amount; |
164 | } |
165 | |
efaf28e9 |
166 | By consuming the C<Comparable> role and defining this method, we gain |
167 | the following methods for free: C<equal_to>, C<greater_than>, |
168 | C<less_than>, C<greater_than_or_equal_to> and |
cb26ee7e |
169 | C<less_than_or_equal_to>. |
170 | |
efaf28e9 |
171 | Then we have our C<to_string> method: |
cb26ee7e |
172 | |
173 | sub to_string { |
174 | my $self = shift; |
a39ea7dc |
175 | sprintf '$%0.2f USD' => $self->amount; |
cb26ee7e |
176 | } |
177 | |
178 | =head1 CONCLUSION |
179 | |
9b3a690c |
180 | Roles can be very powerful. They are a great way of encapsulating |
efaf28e9 |
181 | reusable behavior, as well as communicating (semantic and interface) |
182 | information about the methods our classes provide. |
cb26ee7e |
183 | |
184 | =head1 FOOTNOTES |
185 | |
186 | =over 4 |
187 | |
188 | =item (1) |
189 | |
efaf28e9 |
190 | Consider two classes, C<Runner> and C<Process>, both of which define a |
191 | C<run> method. If we just require that an object implements a C<run> |
192 | method, we still aren't saying anything about what that method |
193 | I<actually does>. If we require an object that implements the |
194 | C<Executable> role, we're saying something about semantics. |
cb26ee7e |
195 | |
196 | =back |
a7d0cd00 |
197 | |
c79239a2 |
198 | =begin testing |
199 | |
200 | ok( US::Currency->does('Comparable'), '... US::Currency does Comparable' ); |
201 | ok( US::Currency->does('Eq'), '... US::Currency does Eq' ); |
202 | ok( US::Currency->does('Printable'), '... US::Currency does Printable' ); |
203 | |
204 | my $hundred = US::Currency->new( amount => 100.00 ); |
205 | isa_ok( $hundred, 'US::Currency' ); |
206 | |
207 | ok( $hundred->DOES("US::Currency"), "UNIVERSAL::DOES for class" ); |
208 | ok( $hundred->DOES("Comparable"), "UNIVERSAL::DOES for role" ); |
209 | |
210 | can_ok( $hundred, 'amount' ); |
211 | is( $hundred->amount, 100, '... got the right amount' ); |
212 | |
213 | can_ok( $hundred, 'to_string' ); |
214 | is( $hundred->to_string, '$100.00 USD', |
215 | '... got the right stringified value' ); |
216 | |
217 | ok( $hundred->does('Comparable'), '... US::Currency does Comparable' ); |
218 | ok( $hundred->does('Eq'), '... US::Currency does Eq' ); |
219 | ok( $hundred->does('Printable'), '... US::Currency does Printable' ); |
220 | |
221 | my $fifty = US::Currency->new( amount => 50.00 ); |
222 | isa_ok( $fifty, 'US::Currency' ); |
223 | |
224 | can_ok( $fifty, 'amount' ); |
225 | is( $fifty->amount, 50, '... got the right amount' ); |
226 | |
227 | can_ok( $fifty, 'to_string' ); |
228 | is( $fifty->to_string, '$50.00 USD', '... got the right stringified value' ); |
229 | |
230 | ok( $hundred->greater_than($fifty), '... 100 gt 50' ); |
231 | ok( $hundred->greater_than_or_equal_to($fifty), '... 100 ge 50' ); |
232 | ok( !$hundred->less_than($fifty), '... !100 lt 50' ); |
233 | ok( !$hundred->less_than_or_equal_to($fifty), '... !100 le 50' ); |
234 | ok( !$hundred->equal_to($fifty), '... !100 eq 50' ); |
235 | ok( $hundred->not_equal_to($fifty), '... 100 ne 50' ); |
236 | |
237 | ok( !$fifty->greater_than($hundred), '... !50 gt 100' ); |
238 | ok( !$fifty->greater_than_or_equal_to($hundred), '... !50 ge 100' ); |
239 | ok( $fifty->less_than($hundred), '... 50 lt 100' ); |
240 | ok( $fifty->less_than_or_equal_to($hundred), '... 50 le 100' ); |
241 | ok( !$fifty->equal_to($hundred), '... !50 eq 100' ); |
242 | ok( $fifty->not_equal_to($hundred), '... 50 ne 100' ); |
243 | |
244 | ok( !$fifty->greater_than($fifty), '... !50 gt 50' ); |
245 | ok( $fifty->greater_than_or_equal_to($fifty), '... !50 ge 50' ); |
246 | ok( !$fifty->less_than($fifty), '... 50 lt 50' ); |
247 | ok( $fifty->less_than_or_equal_to($fifty), '... 50 le 50' ); |
248 | ok( $fifty->equal_to($fifty), '... 50 eq 50' ); |
249 | ok( !$fifty->not_equal_to($fifty), '... !50 ne 50' ); |
250 | |
251 | ## ... check some meta-stuff |
252 | |
253 | # Eq |
254 | |
255 | my $eq_meta = Eq->meta; |
256 | isa_ok( $eq_meta, 'Moose::Meta::Role' ); |
257 | |
258 | ok( $eq_meta->has_method('not_equal_to'), '... Eq has_method not_equal_to' ); |
259 | ok( $eq_meta->requires_method('equal_to'), |
260 | '... Eq requires_method not_equal_to' ); |
261 | |
262 | # Comparable |
263 | |
264 | my $comparable_meta = Comparable->meta; |
265 | isa_ok( $comparable_meta, 'Moose::Meta::Role' ); |
266 | |
267 | ok( $comparable_meta->does_role('Eq'), '... Comparable does Eq' ); |
268 | |
269 | foreach my $method_name ( |
270 | qw( |
271 | equal_to not_equal_to |
272 | greater_than greater_than_or_equal_to |
273 | less_than less_than_or_equal_to |
274 | ) |
275 | ) { |
276 | ok( $comparable_meta->has_method($method_name), |
277 | '... Comparable has_method ' . $method_name ); |
278 | } |
279 | |
280 | ok( $comparable_meta->requires_method('compare'), |
281 | '... Comparable requires_method compare' ); |
282 | |
283 | # Printable |
284 | |
285 | my $printable_meta = Printable->meta; |
286 | isa_ok( $printable_meta, 'Moose::Meta::Role' ); |
287 | |
288 | ok( $printable_meta->requires_method('to_string'), |
289 | '... Printable requires_method to_string' ); |
290 | |
291 | # US::Currency |
292 | |
293 | my $currency_meta = US::Currency->meta; |
294 | isa_ok( $currency_meta, 'Moose::Meta::Class' ); |
295 | |
296 | ok( $currency_meta->does_role('Comparable'), |
297 | '... US::Currency does Comparable' ); |
298 | ok( $currency_meta->does_role('Eq'), '... US::Currency does Eq' ); |
299 | ok( $currency_meta->does_role('Printable'), |
300 | '... US::Currency does Printable' ); |
301 | |
302 | foreach my $method_name ( |
303 | qw( |
304 | amount |
305 | equal_to not_equal_to |
306 | compare |
307 | greater_than greater_than_or_equal_to |
308 | less_than less_than_or_equal_to |
309 | to_string |
310 | ) |
311 | ) { |
312 | ok( $currency_meta->has_method($method_name), |
313 | '... US::Currency has_method ' . $method_name ); |
314 | } |
315 | |
316 | =end testing |
317 | |
a39ea7dc |
318 | =cut |