6 Moose::Cookbook::Basics::Recipe10 - Operator overloading, subtypes, and coercion.
13 use Moose::Util::TypeConstraints;
17 => where { $_ =~ m{^[mf]$}s };
19 has 'gender' => ( is => 'ro', isa => 'Gender', required => 1 );
21 has 'mother' => ( is => 'ro', isa => 'Human' );
22 has 'father' => ( is => 'ro', isa => 'Human' );
24 use overload '+' => \&_overload_add, fallback => 1;
29 die('Only male and female humans may create children')
30 if ($one->gender() eq $two->gender());
32 my ( $mother, $father ) = ( $one->gender eq 'f' ? ($one, $two) : ($two, $one) );
35 $gender = 'm' if (rand() >= 0.5);
46 This Moose cookbook recipe shows how operator overloading, coercion,
47 and sub types can be used to mimic the human reproductive system
48 (well, the selection of genes at least). Assumes a basic
49 understanding of Moose.
53 The example in the SYNOPSIS outlines a very basic use of
54 operator overloading and Moose. The example creates a class
55 that allows you to add together two humans and produce a
58 The two parents must be of the opposite gender, as to do
59 otherwise wouldn't be biologically possible no matter how much
60 I might want to allow it.
62 While this example works and gets the job done, it really isn't
63 all that useful. To take this a step further let's play around
64 with genes. Particularly the genes that dictate eye color. Why
65 eye color? Because it is simple. There are two genes that have
66 the most affect on eye color and each person carries two of each
67 gene. Now that will be useful!
69 Oh, and don't forget that you were promised some coercion goodness.
73 First, let's quickly define the techniques that will be used.
75 =head2 Operator Overloading
77 Overloading operators takes a simple declaration of which operator
78 you want to overload and what method to call. See the perldoc for
79 overload to see some good, basic, examples.
83 Moose comes with 21 default type constraints, as documented in
84 L<Moose::Util::TypeConstraints>. Int, Str, and CodeRef are
85 all examples. Subtypes give you the ability to inherit the
86 constraints of an existing type, and adding additional
87 constraints on that type. An introduction to type constraints
88 is available in the L<Moose::Cookbook::Basics::Recipe4>.
92 When an attribute is assigned a value its type constraint
93 is checked to validate the value. Normally, if the value
94 does not pass the constraint, an exception will be thrown.
95 But, it is possible with Moose to define the rules to coerce
96 values from one type to another. A good introduction to
97 this can be found in L<Moose::Cookbook::Basics::Recipe5>.
101 As I alluded to in the introduction, there are many different
102 genes that affect eye color. But, there are 2 genes that play
103 the most prominent role: gey and bey2. To get started let us
104 make classes for these genes.
108 package Human::Gene::bey2;
111 use Moose::Util::TypeConstraints;
113 type 'bey2Color' => where { $_ =~ m{^(?:brown|blue)$}s };
115 has 'color' => ( is => 'ro', isa => 'bey2Color' );
117 This class is really simple. All we need to know about the bey2
118 gene is whether it is of the blue or brown variety. As you can
119 see a type constraint for the color attribute has been created
120 which validates for the two possible colors.
124 package Human::Gene::gey;
127 use Moose::Util::TypeConstraints;
129 type 'geyColor' => where { $_ =~ m{^(?:green|blue)$}s };
131 has 'color' => ( is => 'ro', isa => 'geyColor' );
133 The gey gene is nearly identical to the bey2, except that it
134 has a green or blue variety.
138 Rather than throwing the 4 gene object (2xbey, 2xgey2) straight
139 on to the Human class, let's create an intermediate class that
140 abstracts the logic behind eye color. This way the Human class
141 won't get all cluttered up with the details behind the different
142 characteristics that makes up a Human.
144 package Human::EyeColor;
147 use Moose::Util::TypeConstraints;
151 => where { $_->isa('Human::Gene::bey2') };
155 => via { Human::Gene::bey2->new( color => $_ ) };
159 => where { $_->isa('Human::Gene::gey') };
163 => via { Human::Gene::gey->new( color => $_ ) };
165 has 'bey2_1' => ( is => 'ro', isa => 'bey2Gene', coerce => 1 );
166 has 'bey2_2' => ( is => 'ro', isa => 'bey2Gene', coerce => 1 );
168 has 'gey_1' => ( is => 'ro', isa => 'geyGene', coerce => 1 );
169 has 'gey_2' => ( is => 'ro', isa => 'geyGene', coerce => 1 );
171 So, we now have a class that can hold the four genes that dictate
172 eye color. This isn't quite enough, as we also need to calculate
173 what the human's actual eye color is as a result of the genes.
175 As with most genes there are recessive and dominant genes. The bey2
176 brown gene is dominant to both blue and green. The gey green gene is
177 recessive to the brown bey gene and dominant to the blues. Finally,
178 the bey and gey2 blue genes are recessive to both brown and green.
183 return 'brown' if ($self->bey2_1->color() eq 'brown' or $self->bey2_2->color() eq 'brown');
184 return 'green' if ($self->gey_1->color() eq 'green' or $self->gey_2->color() eq 'green');
188 To top it off, if I want to access color(), I want to be really lazy
189 about it. Perl overloading supports the ability to overload the
190 stringification of an object. So, normally if I did "$eye_color"
191 I'd get something like "Human::EyeColor=HASH(0xba9348)". What I
192 really want is "brown", "green", or "blue". To do this you overload
193 the stringification of the object.
195 use overload '""' => \&color, fallback => 1;
197 That's all and good, but don't forget the spawn! Our
198 humans have to have children, and those children need to inherit
199 genes from their parents. Let's use operator overloading so
200 that we can add (+) together two EyeColor characteristics to
201 create a new EyeColor that is derived in a similar manner as
202 the gene selection in human reproduction.
204 use overload '+' => \&_overload_add, fallback => 1;
207 my ($one, $two) = @_;
209 my $one_bey2 = 'bey2_' . _rand2();
210 my $two_bey2 = 'bey2_' . _rand2();
212 my $one_gey = 'gey_' . _rand2();
213 my $two_gey = 'gey_' . _rand2();
215 return Human::EyeColor->new(
216 bey2_1 => $one->$one_bey2->color(),
217 bey2_2 => $two->$two_bey2->color(),
218 gey_1 => $one->$one_gey->color(),
219 gey_2 => $two->$two_gey->color(),
224 return 1 + int( rand(2) );
227 What is happening here is we are overloading the addition
228 operator. When two eye color objects are added together
229 the _overload_add() method will be called with the two
230 objects on the left and right side of the + as arguments.
231 The return value of this method should be the expected
232 result of the addition. I'm not going to go in to the
233 details of how the gene's are selected as it should be
234 fairly self-explanatory.
236 =head1 HUMAN EVOLUTION
238 Our original human class in the SYNOPSIS requires very little
239 change to support the new EyeColor characteristic. All we
240 need to do is define a new subtype called EyeColor, a new
241 attribute called eye_color, and just for the sake of simple code
242 we'll coerce an arrayref of colors in to an EyeColor object.
244 use List::MoreUtils qw( zip );
248 => where { $_->isa('Human::EyeColor') };
253 my @genes = qw( bey2_1 bey2_2 gey_1 gey_2 );
254 return Human::EyeColor->new( zip( @genes, @$_ ) );
257 has 'eye_color' => ( is => 'ro', isa => 'EyeColor', coerce => 1, required => 1 );
259 And then in the _overload_add() of the Human class we modify
260 the creation of the child object to include the addition of
261 the mother and father's eye colors.
265 eye_color => ( $one->eye_color() + $two->eye_color() ),
272 The three techniques used in this article - overloading, subtypes,
273 and coercion - provide the power to produce simple, flexible, powerful,
274 explicit, inheritable, and enjoyable interfaces.
276 If you want to get your hands on this code all combined together, and
277 working, download the Moose tarball and look at "t/000_recipes/012_genes.t".
281 Has this been a real project we'd probably want to:
285 =item Better Randomization with Crypt::Random
287 =item Characteristic Base Class
291 =item More Characteristics
293 =item Artificial Life
299 Aran Clary Deltac <bluefeet@cpan.org>
303 This work is licensed under a Creative Commons Attribution 3.0 Unported License.
305 License details are at: L<http://creativecommons.org/licenses/by/3.0/>