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