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