Rename Meta::Recipe7 to Meta::GlobRef_InstanceMetaclass
[gitmo/Moose.git] / lib / Moose / Cookbook / Roles / Comparable_CodeReuse.pod
1 package Moose::Cookbook::Roles::Comparable_CodeReuse;
2
3 # ABSTRACT: Using roles for code reuse
4
5 __END__
6
7
8 =pod
9
10 =head1 SYNOPSIS
11
12   package Eq;
13   use Moose::Role;
14
15   requires 'equal_to';
16
17   sub not_equal_to {
18       my ( $self, $other ) = @_;
19       not $self->equal_to($other);
20   }
21
22   package Comparable;
23   use Moose::Role;
24
25   with 'Eq';
26
27   requires 'compare';
28
29   sub equal_to {
30       my ( $self, $other ) = @_;
31       $self->compare($other) == 0;
32   }
33
34   sub greater_than {
35       my ( $self, $other ) = @_;
36       $self->compare($other) == 1;
37   }
38
39   sub less_than {
40       my ( $self, $other ) = @_;
41       $self->compare($other) == -1;
42   }
43
44   sub greater_than_or_equal_to {
45       my ( $self, $other ) = @_;
46       $self->greater_than($other) || $self->equal_to($other);
47   }
48
49   sub less_than_or_equal_to {
50       my ( $self, $other ) = @_;
51       $self->less_than($other) || $self->equal_to($other);
52   }
53
54   package Printable;
55   use Moose::Role;
56
57   requires 'to_string';
58
59   package US::Currency;
60   use Moose;
61
62   with 'Comparable', 'Printable';
63
64   has 'amount' => ( is => 'rw', isa => 'Num', default => 0 );
65
66   sub compare {
67       my ( $self, $other ) = @_;
68       $self->amount <=> $other->amount;
69   }
70
71   sub to_string {
72       my $self = shift;
73       sprintf '$%0.2f USD' => $self->amount;
74   }
75
76 =head1 DESCRIPTION
77
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.
81
82 Let's start with C<Eq>. First, note that we've replaced C<use Moose>
83 with C<use Moose::Role>. We also have a new sugar function, C<requires>:
84
85   requires 'equal_to';
86
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.
90
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.
94
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:
97
98   with 'Eq';
99
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.
106
107 The C<Comparable> role requires a method,  C<compare>:
108
109   requires 'compare';
110
111 The C<Comparable> role also provides a number of other methods, all of
112 which ultimately rely on C<compare>.
113
114   sub equal_to {
115       my ( $self, $other ) = @_;
116       $self->compare($other) == 0;
117   }
118
119   sub greater_than {
120       my ( $self, $other ) = @_;
121       $self->compare($other) == 1;
122   }
123
124   sub less_than {
125       my ( $self, $other ) = @_;
126       $self->compare($other) == -1;
127   }
128
129   sub greater_than_or_equal_to {
130       my ( $self, $other ) = @_;
131       $self->greater_than($other) || $self->equal_to($other);
132   }
133
134   sub less_than_or_equal_to {
135       my ( $self, $other ) = @_;
136       $self->less_than($other) || $self->equal_to($other);
137   }
138
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.
142
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.
151
152   with 'Comparable', 'Printable';
153
154 It also defines a regular Moose attribute, C<amount>:
155
156   has 'amount' => ( is => 'rw', isa => 'Num', default => 0 );
157
158 Finally we see the implementation of the methods required by our
159 roles. We have a C<compare> method:
160
161   sub compare {
162       my ( $self, $other ) = @_;
163       $self->amount <=> $other->amount;
164   }
165
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
169 C<less_than_or_equal_to>.
170
171 Then we have our C<to_string> method:
172
173   sub to_string {
174       my $self = shift;
175       sprintf '$%0.2f USD' => $self->amount;
176   }
177
178 =head1 CONCLUSION
179
180 Roles can be very powerful. They are a great way of encapsulating
181 reusable behavior, as well as communicating (semantic and interface)
182 information about the methods our classes provide.
183
184 =head1 FOOTNOTES
185
186 =over 4
187
188 =item (1)
189
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.
195
196 =back
197
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
318 =cut