local-lib5/lib/perl5/Moose/Cookbook/Roles/Recipe1.pod

   1
   2 =pod
   3
   4 =head1 NAME
   5
   6 Moose::Cookbook::Roles::Recipe1 - The Moose::Role example
   7
   8 =head1 SYNOPSIS
   9
  10   package Eq;
  11   use Moose::Role;
  12
  13   requires 'equal_to';
  14
  15   sub not_equal_to {
  16       my ( $self, $other ) = @_;
  17       not $self->equal_to($other);
  18   }
  19
  20   package Comparable;
  21   use Moose::Role;
  22
  23   with 'Eq';
  24
  25   requires 'compare';
  26
  27   sub equal_to {
  28       my ( $self, $other ) = @_;
  29       $self->compare($other) == 0;
  30   }
  31
  32   sub greater_than {
  33       my ( $self, $other ) = @_;
  34       $self->compare($other) == 1;
  35   }
  36
  37   sub less_than {
  38       my ( $self, $other ) = @_;
  39       $self->compare($other) == -1;
  40   }
  41
  42   sub greater_than_or_equal_to {
  43       my ( $self, $other ) = @_;
  44       $self->greater_than($other) || $self->equal_to($other);
  45   }
  46
  47   sub less_than_or_equal_to {
  48       my ( $self, $other ) = @_;
  49       $self->less_than($other) || $self->equal_to($other);
  50   }
  51
  52   package Printable;
  53   use Moose::Role;
  54
  55   requires 'to_string';
  56
  57   package US::Currency;
  58   use Moose;
  59
  60   with 'Comparable', 'Printable';
  61
  62   has 'amount' => ( is => 'rw', isa => 'Num', default => 0 );
  63
  64   sub compare {
  65       my ( $self, $other ) = @_;
  66       $self->amount <=> $other->amount;
  67   }
  68
  69   sub to_string {
  70       my $self = shift;
  71       sprintf '$%0.2f USD' => $self->amount;
  72   }
  73
  74 =head1 DESCRIPTION
  75
  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.
  79
  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>:
  82
  83   requires 'equal_to';
  84
  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.
  88
  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.
  92
  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:
  95
  96   with 'Eq';
  97
  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.
 104
 105 The C<Comparable> role requires a method,  C<compare>:
 106
 107   requires 'compare';
 108
 109 The C<Comparable> role also provides a number of other methods, all of
 110 which ultimately rely on C<compare>.
 111
 112   sub equal_to {
 113       my ( $self, $other ) = @_;
 114       $self->compare($other) == 0;
 115   }
 116
 117   sub greater_than {
 118       my ( $self, $other ) = @_;
 119       $self->compare($other) == 1;
 120   }
 121
 122   sub less_than {
 123       my ( $self, $other ) = @_;
 124       $self->compare($other) == -1;
 125   }
 126
 127   sub greater_than_or_equal_to {
 128       my ( $self, $other ) = @_;
 129       $self->greater_than($other) || $self->equal_to($other);
 130   }
 131
 132   sub less_than_or_equal_to {
 133       my ( $self, $other ) = @_;
 134       $self->less_than($other) || $self->equal_to($other);
 135   }
 136
 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.
 140
 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.
 149
 150   with 'Comparable', 'Printable';
 151
 152 It also defines a regular Moose attribute, C<amount>:
 153
 154   has 'amount' => ( is => 'rw', isa => 'Num', default => 0 );
 155
 156 Finally we see the implementation of the methods required by our
 157 roles. We have a C<compare> method:
 158
 159   sub compare {
 160       my ( $self, $other ) = @_;
 161       $self->amount <=> $other->amount;
 162   }
 163
 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>.
 168
 169 Then we have our C<to_string> method:
 170
 171   sub to_string {
 172       my $self = shift;
 173       sprintf '$%0.2f USD' => $self->amount;
 174   }
 175
 176 =head1 CONCLUSION
 177
 178 Roles can be 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.
 181
 182 =head1 FOOTNOTES
 183
 184 =over 4
 185
 186 =item (1)
 187
 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.
 193
 194 =back
 195
 196 =head1 AUTHORS
 197
 198 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 199
 200 Dave Rolsky E<lt>autarch@urth.orgE<gt>
 201
 202 =head1 COPYRIGHT AND LICENSE
 203
 204 Copyright 2006-2009 by Infinity Interactive, Inc.
 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
 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
 331 =cut