6 Moose::Cookbook::Roles::Recipe1 - The Moose::Role example
16 my ( $self, $other ) = @_;
17 not $self->equal_to($other);
28 my ( $self, $other ) = @_;
29 $self->compare($other) == 0;
33 my ( $self, $other ) = @_;
34 $self->compare($other) == 1;
38 my ( $self, $other ) = @_;
39 $self->compare($other) == -1;
42 sub greater_than_or_equal_to {
43 my ( $self, $other ) = @_;
44 $self->greater_than($other) || $self->equal_to($other);
47 sub less_than_or_equal_to {
48 my ( $self, $other ) = @_;
49 $self->less_than($other) || $self->equal_to($other);
60 with 'Comparable', 'Printable';
62 has 'amount' => ( is => 'rw', isa => 'Num', default => 0 );
65 my ( $self, $other ) = @_;
66 $self->amount <=> $other->amount;
71 sprintf '$%0.2f USD' => $self->amount;
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.
80 Let's start with C<Eq>. First, note that we've replaced C<use Moose>
81 with C<use Moose::Role>. We also have a new sugar function, C<requires>:
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.
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.
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:
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
105 The C<Comparable> role requires a method, C<compare>:
109 The C<Comparable> role also provides a number of other methods, all of
110 which ultimately rely on C<compare>.
113 my ( $self, $other ) = @_;
114 $self->compare($other) == 0;
118 my ( $self, $other ) = @_;
119 $self->compare($other) == 1;
123 my ( $self, $other ) = @_;
124 $self->compare($other) == -1;
127 sub greater_than_or_equal_to {
128 my ( $self, $other ) = @_;
129 $self->greater_than($other) || $self->equal_to($other);
132 sub less_than_or_equal_to {
133 my ( $self, $other ) = @_;
134 $self->less_than($other) || $self->equal_to($other);
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.
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)
147 Finally, we have the C<US::Currency> class which consumes both the
148 C<Comparable> and C<Printable> roles.
150 with 'Comparable', 'Printable';
152 It also defines a regular Moose attribute, C<amount>:
154 has 'amount' => ( is => 'rw', isa => 'Num', default => 0 );
156 Finally we see the implementation of the methods required by our
157 roles. We have a C<compare> method:
160 my ( $self, $other ) = @_;
161 $self->amount <=> $other->amount;
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
167 C<less_than_or_equal_to>.
169 Then we have our C<to_string> method:
173 sprintf '$%0.2f USD' => $self->amount;
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.
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.
198 Stevan Little E<lt>stevan@iinteractive.comE<gt>
200 Dave Rolsky E<lt>autarch@urth.orgE<gt>
202 =head1 COPYRIGHT AND LICENSE
204 Copyright 2006-2009 by Infinity Interactive, Inc.
206 L<http://www.iinteractive.com>
208 This library is free software; you can redistribute it and/or modify
209 it under the same terms as Perl itself.
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' );
217 my $hundred = US::Currency->new( amount => 100.00 );
218 isa_ok( $hundred, 'US::Currency' );
220 ok( $hundred->DOES("US::Currency"), "UNIVERSAL::DOES for class" );
221 ok( $hundred->DOES("Comparable"), "UNIVERSAL::DOES for role" );
223 can_ok( $hundred, 'amount' );
224 is( $hundred->amount, 100, '... got the right amount' );
226 can_ok( $hundred, 'to_string' );
227 is( $hundred->to_string, '$100.00 USD',
228 '... got the right stringified value' );
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' );
234 my $fifty = US::Currency->new( amount => 50.00 );
235 isa_ok( $fifty, 'US::Currency' );
237 can_ok( $fifty, 'amount' );
238 is( $fifty->amount, 50, '... got the right amount' );
240 can_ok( $fifty, 'to_string' );
241 is( $fifty->to_string, '$50.00 USD', '... got the right stringified value' );
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' );
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' );
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' );
264 ## ... check some meta-stuff
268 my $eq_meta = Eq->meta;
269 isa_ok( $eq_meta, 'Moose::Meta::Role' );
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' );
277 my $comparable_meta = Comparable->meta;
278 isa_ok( $comparable_meta, 'Moose::Meta::Role' );
280 ok( $comparable_meta->does_role('Eq'), '... Comparable does Eq' );
282 foreach my $method_name (
284 equal_to not_equal_to
285 greater_than greater_than_or_equal_to
286 less_than less_than_or_equal_to
289 ok( $comparable_meta->has_method($method_name),
290 '... Comparable has_method ' . $method_name );
293 ok( $comparable_meta->requires_method('compare'),
294 '... Comparable requires_method compare' );
298 my $printable_meta = Printable->meta;
299 isa_ok( $printable_meta, 'Moose::Meta::Role' );
301 ok( $printable_meta->requires_method('to_string'),
302 '... Printable requires_method to_string' );
306 my $currency_meta = US::Currency->meta;
307 isa_ok( $currency_meta, 'Moose::Meta::Class' );
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' );
315 foreach my $method_name (
318 equal_to not_equal_to
320 greater_than greater_than_or_equal_to
321 less_than less_than_or_equal_to
325 ok( $currency_meta->has_method($method_name),
326 '... US::Currency has_method ' . $method_name );