lib/Moose/Cookbook/Basics/Recipe10.pod

   1
   2 =pod
   3
   4 =head1 NAME
   5
   6 Moose::Cookbook::Basics::Recipe10 - Operator overloading, subtypes, and coercion
   7
   8 =head1 SYNOPSIS
   9
  10   package Human;
  11
  12   use Moose;
  13   use Moose::Util::TypeConstraints;
  14
  15   subtype 'Gender'
  16       => as 'Str'
  17       => where { $_ =~ m{^[mf]$}s };
  18
  19   has 'gender' => ( is => 'ro', isa => 'Gender', required => 1 );
  20
  21   has 'mother' => ( is => 'ro', isa => 'Human' );
  22   has 'father' => ( is => 'ro', isa => 'Human' );
  23
  24   use overload '+' => \&_overload_add, fallback => 1;
  25
  26   sub _overload_add {
  27       my ( $one, $two ) = @_;
  28
  29       die('Only male and female humans may create children')
  30           if ( $one->gender() eq $two->gender() );
  31
  32       my ( $mother, $father )
  33           = ( $one->gender eq 'f' ? ( $one, $two ) : ( $two, $one ) );
  34
  35       my $gender = 'f';
  36       $gender = 'm' if ( rand() >= 0.5 );
  37
  38       return Human->new(
  39           gender => $gender,
  40           mother => $mother,
  41           father => $father,
  42       );
  43   }
  44
  45 =head1 DESCRIPTION
  46
  47 This Moose cookbook recipe shows how operator overloading, coercion,
  48 and sub types can be used to mimic the human reproductive system
  49 (well, the selection of genes at least).  Assumes a basic
  50 understanding of Moose.
  51
  52 =head1 INTRODUCTION
  53
  54 The example in the L</"SYNOPSIS"> outlines a very basic use of
  55 operator overloading and Moose.  The example creates a class
  56 that allows you to add together two humans and produce a
  57 child from them.
  58
  59 The two parents must be of the opposite gender, as to do
  60 otherwise wouldn't be biologically possible no matter how much
  61 I might want to allow it.
  62
  63 While this example works and gets the job done, it really isn't
  64 all that useful.  To take this a step further let's play around
  65 with genes.  Particularly the genes that dictate eye color.  Why
  66 eye color?  Because it is simple.  There are two genes that have
  67 the most effect on eye color and each person carries two of each
  68 gene.  Now that will be useful!
  69
  70 Oh, and don't forget that you were promised some coercion goodness.
  71
  72 =head1 TECHNIQUES
  73
  74 First, let's quickly define the techniques that will be used.
  75
  76 =head2 Operator Overloading
  77
  78 Overloading operators takes a simple declaration of which operator
  79 you want to overload and what method to call.  See
  80 L<overload> to see some good, basic, examples.
  81
  82 =head2 Subtypes
  83
  84 Moose comes with 21 default type constraints, as documented in
  85 L<Moose::Util::TypeConstraints>.  C<Int>, C<Str>, and C<CodeRef> are
  86 all examples.  Subtypes give you the ability to inherit the
  87 constraints of an existing type, and adding additional
  88 constraints on that type.  An introduction to type constraints
  89 is available in the L<Moose::Cookbook::Basics::Recipe4>.
  90
  91 =head2 Coercion
  92
  93 When an attribute is assigned a value its type constraint
  94 is checked to validate the value.  Normally, if the value
  95 does not pass the constraint, an exception will be thrown.
  96 But, it is possible with Moose to define the rules to coerce
  97 values from one type to another.  A good introduction to
  98 this can be found in L<Moose::Cookbook::Basics::Recipe5>.
  99
 100 =head1 GENES
 101
 102 As I alluded to in the introduction, there are many different
 103 genes that affect eye color.  But, there are 2 genes that play
 104 the most prominent role: I<gey> and I<bey2>.  To get started let us
 105 make classes for these genes.
 106
 107 =head2 bey2
 108
 109   package Human::Gene::bey2;
 110
 111   use Moose;
 112   use Moose::Util::TypeConstraints;
 113
 114   type 'bey2Color' => where { $_ =~ m{^(?:brown|blue)$}s };
 115
 116   has 'color' => ( is => 'ro', isa => 'bey2Color' );
 117
 118 This class is really simple.  All we need to know about the I<bey2>
 119 gene is whether it is of the blue or brown variety.  As you can
 120 see a type constraint for the color attribute has been created
 121 which validates for the two possible colors.
 122
 123 =head2 gey
 124
 125   package Human::Gene::gey;
 126
 127   use Moose;
 128   use Moose::Util::TypeConstraints;
 129
 130   type 'geyColor' => where { $_ =~ m{^(?:green|blue)$}s };
 131
 132   has 'color' => ( is => 'ro', isa => 'geyColor' );
 133
 134 The I<gey> gene is nearly identical to I<bey2>, except that it
 135 has a green or blue variety.
 136
 137 =head1 EYE COLOR
 138
 139 Rather than throwing the 4 gene object (2 x I<bey>, 2 x I<gey2>) straight
 140 on to the C<Human> class, let's create an intermediate class that
 141 abstracts the logic behind eye color.  This way the C<Human> class
 142 won't get all cluttered up with the details behind the different
 143 characteristics that makes up a Human.
 144
 145   package Human::EyeColor;
 146
 147   use Moose;
 148   use Moose::Util::TypeConstraints;
 149
 150   subtype 'bey2Gene'
 151       => as 'Object'
 152       => where { $_->isa('Human::Gene::bey2') };
 153
 154   coerce 'bey2Gene'
 155       => from 'Str'
 156           => via { Human::Gene::bey2->new( color => $_ ) };
 157
 158   subtype 'geyGene'
 159       => as 'Object'
 160       => where { $_->isa('Human::Gene::gey') };
 161
 162   coerce 'geyGene'
 163       => from 'Str'
 164           => via { Human::Gene::gey->new( color => $_ ) };
 165
 166   has 'bey2_1' => ( is => 'ro', isa => 'bey2Gene', coerce => 1 );
 167   has 'bey2_2' => ( is => 'ro', isa => 'bey2Gene', coerce => 1 );
 168
 169   has 'gey_1' => ( is => 'ro', isa => 'geyGene', coerce => 1 );
 170   has 'gey_2' => ( is => 'ro', isa => 'geyGene', coerce => 1 );
 171
 172 So, we now have a class that can hold the four genes that dictate
 173 eye color.  This isn't quite enough, as we also need to calculate
 174 what the human's actual eye color is as a result of the genes.
 175
 176 As with most genes there are recessive and dominant genes.  The I<bey2>
 177 brown gene is dominant to both blue and green.  The I<gey> green gene is
 178 recessive to the brown I<bey> gene and dominant to the blues.  Finally,
 179 the I<bey> and I<gey2> blue genes are recessive to both brown and green.
 180
 181   sub color {
 182       my ($self) = @_;
 183
 184       return 'brown'
 185           if ( $self->bey2_1->color() eq 'brown'
 186           or $self->bey2_2->color() eq 'brown' );
 187
 188       return 'green'
 189           if ( $self->gey_1->color() eq 'green'
 190           or $self->gey_2->color() eq 'green' );
 191
 192       return 'blue';
 193   }
 194
 195 To top it off, if I want to access C<color()>, I want to be really lazy
 196 about it.  Perl overloading supports the ability to overload the
 197 stringification of an object.  So, normally if I did C<$eye_color>
 198 I'd get something like C<Human::EyeColor=HASH(0xba9348)>.  What I
 199 really want is "brown", "green", or "blue".  To do this you overload
 200 the stringification of the object.
 201
 202   use overload '""' => \&color, fallback => 1;
 203
 204 That's all and good, but don't forget the spawn!  Our
 205 humans have to have children, and those children need to inherit
 206 genes from their parents.  Let's use operator overloading so
 207 that we can add (+) together two C<EyeColor> characteristics to
 208 create a new C<EyeColor> that is derived in a similar manner as
 209 the gene selection in human reproduction.
 210
 211   use overload '+' => \&_overload_add, fallback => 1;
 212
 213   sub _overload_add {
 214       my ( $one, $two ) = @_;
 215
 216       my $one_bey2 = 'bey2_' . _rand2();
 217       my $two_bey2 = 'bey2_' . _rand2();
 218
 219       my $one_gey = 'gey_' . _rand2();
 220       my $two_gey = 'gey_' . _rand2();
 221
 222       return Human::EyeColor->new(
 223           bey2_1 => $one->$one_bey2->color(),
 224           bey2_2 => $two->$two_bey2->color(),
 225           gey_1  => $one->$one_gey->color(),
 226           gey_2  => $two->$two_gey->color(),
 227       );
 228   }
 229
 230   sub _rand2 {
 231       return 1 + int( rand(2) );
 232   }
 233
 234 What is happening here is we are overloading the addition
 235 operator.  When two eye color objects are added together
 236 the C<_overload_add()> method will be called with the two
 237 objects on the left and right side of the C<+> as arguments.
 238 The return value of this method should be the expected
 239 result of the addition.  I'm not going to go in to the
 240 details of how the gene's are selected as it should be
 241 fairly self-explanatory.
 242
 243 =head1 HUMAN EVOLUTION
 244
 245 Our original human class in the L</"SYNOPSIS"> requires very little
 246 change to support the new C<EyeColor> characteristic.  All we
 247 need to do is define a new subtype called C<EyeColor>, a new
 248 attribute called C<eye_color>, and just for the sake of simple code
 249 we'll coerce an arrayref of colors in to an C<EyeColor> object.
 250
 251   use List::MoreUtils qw( zip );
 252
 253   subtype 'EyeColor'
 254       => as 'Object'
 255       => where { $_->isa('Human::EyeColor') };
 256
 257   coerce 'EyeColor'
 258       => from 'ArrayRef'
 259       => via { my @genes = qw( bey2_1 bey2_2 gey_1 gey_2 );
 260               return Human::EyeColor->new( zip( @genes, @$_ ) ); };
 261
 262   has 'eye_color' =>
 263       ( is => 'ro', isa => 'EyeColor', coerce => 1, required => 1 );
 264
 265 And then in the C<_overload_add()> of the C<Human> class we modify
 266 the creation of the child object to include the addition of
 267 the mother and father's eye colors.
 268
 269   return Human->new(
 270       gender    => $gender,
 271       eye_color => ( $one->eye_color() + $two->eye_color() ),
 272       mother    => $mother,
 273       father    => $father,
 274   );
 275
 276 =head1 CONCLUSION
 277
 278 The three techniques used in this article - overloading, subtypes,
 279 and coercion - provide the power to produce simple, flexible, powerful,
 280 explicit, inheritable, and enjoyable interfaces.
 281
 282 If you want to get your hands on this code all combined together, and
 283 working, download the Moose tarball and look at
 284 F<t/000_recipes/basics/010_genes.t>.
 285
 286 =head1 NEXT STEPS
 287
 288 Has this been a real project we'd probably want to:
 289
 290 =over 4
 291
 292 =item Better Randomization with Crypt::Random
 293
 294 =item Characteristic Base Class
 295
 296 =item Mutating Genes
 297
 298 =item More Characteristics
 299
 300 =item Artificial Life
 301
 302 =back
 303
 304 =head1 AUTHOR
 305
 306 Aran Clary Deltac <bluefeet@cpan.org>
 307
 308 =head1 LICENSE
 309
 310 This work is licensed under a Creative Commons Attribution 3.0 Unported License.
 311
 312 License details are at: L<http://creativecommons.org/licenses/by/3.0/>
 313
 314 =cut
 315