/usr/lib/perl5/Moose/Cookbook/Roles/Recipe1.pod is in libmoose-perl 2.0401-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 | package Moose::Cookbook::Roles::Recipe1;
# ABSTRACT: The Moose::Role example
=pod
=head1 NAME
Moose::Cookbook::Roles::Recipe1 - The Moose::Role example
=head1 VERSION
version 2.0401
=head1 SYNOPSIS
package Eq;
use Moose::Role;
requires 'equal_to';
sub not_equal_to {
my ( $self, $other ) = @_;
not $self->equal_to($other);
}
package Comparable;
use Moose::Role;
with 'Eq';
requires 'compare';
sub equal_to {
my ( $self, $other ) = @_;
$self->compare($other) == 0;
}
sub greater_than {
my ( $self, $other ) = @_;
$self->compare($other) == 1;
}
sub less_than {
my ( $self, $other ) = @_;
$self->compare($other) == -1;
}
sub greater_than_or_equal_to {
my ( $self, $other ) = @_;
$self->greater_than($other) || $self->equal_to($other);
}
sub less_than_or_equal_to {
my ( $self, $other ) = @_;
$self->less_than($other) || $self->equal_to($other);
}
package Printable;
use Moose::Role;
requires 'to_string';
package US::Currency;
use Moose;
with 'Comparable', 'Printable';
has 'amount' => ( is => 'rw', isa => 'Num', default => 0 );
sub compare {
my ( $self, $other ) = @_;
$self->amount <=> $other->amount;
}
sub to_string {
my $self = shift;
sprintf '$%0.2f USD' => $self->amount;
}
=head1 DESCRIPTION
Roles have two primary purposes: as interfaces, and as a means of code
reuse. This recipe demonstrates the latter, with roles that define
comparison and display code for objects.
Let's start with C<Eq>. First, note that we've replaced C<use Moose>
with C<use Moose::Role>. We also have a new sugar function, C<requires>:
requires 'equal_to';
This says that any class which consumes this role must provide an
C<equal_to> method. It can provide this method directly, or by
consuming some other role.
The C<Eq> role defines its C<not_equal_to> method in terms of the
required C<equal_to> method. This lets us minimize the methods that
consuming classes must provide.
The next role, C<Comparable>, builds on the C<Eq> role. We include
C<Eq> in C<Comparable> using C<with>, another new sugar function:
with 'Eq';
The C<with> function takes a list of roles to consume. In our example,
the C<Comparable> role provides the C<equal_to> method required by
C<Eq>. However, it could opt not to, in which case a class that
consumed C<Comparable> would have to provide its own C<equal_to>. In
other words, a role can consume another role I<without> providing any
required methods.
The C<Comparable> role requires a method, C<compare>:
requires 'compare';
The C<Comparable> role also provides a number of other methods, all of
which ultimately rely on C<compare>.
sub equal_to {
my ( $self, $other ) = @_;
$self->compare($other) == 0;
}
sub greater_than {
my ( $self, $other ) = @_;
$self->compare($other) == 1;
}
sub less_than {
my ( $self, $other ) = @_;
$self->compare($other) == -1;
}
sub greater_than_or_equal_to {
my ( $self, $other ) = @_;
$self->greater_than($other) || $self->equal_to($other);
}
sub less_than_or_equal_to {
my ( $self, $other ) = @_;
$self->less_than($other) || $self->equal_to($other);
}
Finally, we define the C<Printable> role. This role exists solely to
provide an interface. It has no methods, just a list of required methods.
In this case, it just requires a C<to_string> method.
An interface role is useful because it defines both a method and a
I<name>. We know that any class which does this role has a
C<to_string> method, but we can also assume that this method has the
semantics we want. Presumably, in real code we would define those
semantics in the documentation for the C<Printable> role. (1)
Finally, we have the C<US::Currency> class which consumes both the
C<Comparable> and C<Printable> roles.
with 'Comparable', 'Printable';
It also defines a regular Moose attribute, C<amount>:
has 'amount' => ( is => 'rw', isa => 'Num', default => 0 );
Finally we see the implementation of the methods required by our
roles. We have a C<compare> method:
sub compare {
my ( $self, $other ) = @_;
$self->amount <=> $other->amount;
}
By consuming the C<Comparable> role and defining this method, we gain
the following methods for free: C<equal_to>, C<greater_than>,
C<less_than>, C<greater_than_or_equal_to> and
C<less_than_or_equal_to>.
Then we have our C<to_string> method:
sub to_string {
my $self = shift;
sprintf '$%0.2f USD' => $self->amount;
}
=head1 CONCLUSION
Roles can be very powerful. They are a great way of encapsulating
reusable behavior, as well as communicating (semantic and interface)
information about the methods our classes provide.
=head1 FOOTNOTES
=over 4
=item (1)
Consider two classes, C<Runner> and C<Process>, both of which define a
C<run> method. If we just require that an object implements a C<run>
method, we still aren't saying anything about what that method
I<actually does>. If we require an object that implements the
C<Executable> role, we're saying something about semantics.
=back
=begin testing
ok( US::Currency->does('Comparable'), '... US::Currency does Comparable' );
ok( US::Currency->does('Eq'), '... US::Currency does Eq' );
ok( US::Currency->does('Printable'), '... US::Currency does Printable' );
my $hundred = US::Currency->new( amount => 100.00 );
isa_ok( $hundred, 'US::Currency' );
ok( $hundred->DOES("US::Currency"), "UNIVERSAL::DOES for class" );
ok( $hundred->DOES("Comparable"), "UNIVERSAL::DOES for role" );
can_ok( $hundred, 'amount' );
is( $hundred->amount, 100, '... got the right amount' );
can_ok( $hundred, 'to_string' );
is( $hundred->to_string, '$100.00 USD',
'... got the right stringified value' );
ok( $hundred->does('Comparable'), '... US::Currency does Comparable' );
ok( $hundred->does('Eq'), '... US::Currency does Eq' );
ok( $hundred->does('Printable'), '... US::Currency does Printable' );
my $fifty = US::Currency->new( amount => 50.00 );
isa_ok( $fifty, 'US::Currency' );
can_ok( $fifty, 'amount' );
is( $fifty->amount, 50, '... got the right amount' );
can_ok( $fifty, 'to_string' );
is( $fifty->to_string, '$50.00 USD', '... got the right stringified value' );
ok( $hundred->greater_than($fifty), '... 100 gt 50' );
ok( $hundred->greater_than_or_equal_to($fifty), '... 100 ge 50' );
ok( !$hundred->less_than($fifty), '... !100 lt 50' );
ok( !$hundred->less_than_or_equal_to($fifty), '... !100 le 50' );
ok( !$hundred->equal_to($fifty), '... !100 eq 50' );
ok( $hundred->not_equal_to($fifty), '... 100 ne 50' );
ok( !$fifty->greater_than($hundred), '... !50 gt 100' );
ok( !$fifty->greater_than_or_equal_to($hundred), '... !50 ge 100' );
ok( $fifty->less_than($hundred), '... 50 lt 100' );
ok( $fifty->less_than_or_equal_to($hundred), '... 50 le 100' );
ok( !$fifty->equal_to($hundred), '... !50 eq 100' );
ok( $fifty->not_equal_to($hundred), '... 50 ne 100' );
ok( !$fifty->greater_than($fifty), '... !50 gt 50' );
ok( $fifty->greater_than_or_equal_to($fifty), '... !50 ge 50' );
ok( !$fifty->less_than($fifty), '... 50 lt 50' );
ok( $fifty->less_than_or_equal_to($fifty), '... 50 le 50' );
ok( $fifty->equal_to($fifty), '... 50 eq 50' );
ok( !$fifty->not_equal_to($fifty), '... !50 ne 50' );
## ... check some meta-stuff
# Eq
my $eq_meta = Eq->meta;
isa_ok( $eq_meta, 'Moose::Meta::Role' );
ok( $eq_meta->has_method('not_equal_to'), '... Eq has_method not_equal_to' );
ok( $eq_meta->requires_method('equal_to'),
'... Eq requires_method not_equal_to' );
# Comparable
my $comparable_meta = Comparable->meta;
isa_ok( $comparable_meta, 'Moose::Meta::Role' );
ok( $comparable_meta->does_role('Eq'), '... Comparable does Eq' );
foreach my $method_name (
qw(
equal_to not_equal_to
greater_than greater_than_or_equal_to
less_than less_than_or_equal_to
)
) {
ok( $comparable_meta->has_method($method_name),
'... Comparable has_method ' . $method_name );
}
ok( $comparable_meta->requires_method('compare'),
'... Comparable requires_method compare' );
# Printable
my $printable_meta = Printable->meta;
isa_ok( $printable_meta, 'Moose::Meta::Role' );
ok( $printable_meta->requires_method('to_string'),
'... Printable requires_method to_string' );
# US::Currency
my $currency_meta = US::Currency->meta;
isa_ok( $currency_meta, 'Moose::Meta::Class' );
ok( $currency_meta->does_role('Comparable'),
'... US::Currency does Comparable' );
ok( $currency_meta->does_role('Eq'), '... US::Currency does Eq' );
ok( $currency_meta->does_role('Printable'),
'... US::Currency does Printable' );
foreach my $method_name (
qw(
amount
equal_to not_equal_to
compare
greater_than greater_than_or_equal_to
less_than less_than_or_equal_to
to_string
)
) {
ok( $currency_meta->has_method($method_name),
'... US::Currency has_method ' . $method_name );
}
=end testing
=head1 AUTHOR
Moose is maintained by the Moose Cabal, along with the help of many contributors. See L<Moose/CABAL> and L<Moose/CONTRIBUTORS> for details.
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011 by Infinity Interactive, Inc..
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
__END__
|