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;
27 my ( $one, $two ) = @_;
29 die('Only male and female humans may create children')
30 if ( $one->gender() eq $two->gender() );
32 my ( $mother, $father )
33 = ( $one->gender eq 'f' ? ( $one, $two ) : ( $two, $one ) );
36 $gender = 'm' if ( rand() >= 0.5 );
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.
54 The example in the 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
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.
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 affect on eye color and each person carries two of each
68 gene. Now that will be useful!
70 Oh, and don't forget that you were promised some coercion goodness.
74 First, let's quickly define the techniques that will be used.
76 =head2 Operator Overloading
78 Overloading operators takes a simple declaration of which operator
79 you want to overload and what method to call. See the perldoc for
80 overload to see some good, basic, examples.
84 Moose comes with 21 default type constraints, as documented in
85 L<Moose::Util::TypeConstraints>. Int, Str, and 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>.
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>.
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: gey and bey2. To get started let us
105 make classes for these genes.
109 package Human::Gene::bey2;
112 use Moose::Util::TypeConstraints;
114 type 'bey2Color' => where { $_ =~ m{^(?:brown|blue)$}s };
116 has 'color' => ( is => 'ro', isa => 'bey2Color' );
118 This class is really simple. All we need to know about the 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.
125 package Human::Gene::gey;
128 use Moose::Util::TypeConstraints;
130 type 'geyColor' => where { $_ =~ m{^(?:green|blue)$}s };
132 has 'color' => ( is => 'ro', isa => 'geyColor' );
134 The gey gene is nearly identical to the bey2, except that it
135 has a green or blue variety.
139 Rather than throwing the 4 gene object (2xbey, 2xgey2) straight
140 on to the Human class, let's create an intermediate class that
141 abstracts the logic behind eye color. This way the Human class
142 won't get all cluttered up with the details behind the different
143 characteristics that makes up a Human.
145 package Human::EyeColor;
148 use Moose::Util::TypeConstraints;
152 => where { $_->isa('Human::Gene::bey2') };
156 => via { Human::Gene::bey2->new( color => $_ ) };
160 => where { $_->isa('Human::Gene::gey') };
164 => via { Human::Gene::gey->new( color => $_ ) };
166 has 'bey2_1' => ( is => 'ro', isa => 'bey2Gene', coerce => 1 );
167 has 'bey2_2' => ( is => 'ro', isa => 'bey2Gene', coerce => 1 );
169 has 'gey_1' => ( is => 'ro', isa => 'geyGene', coerce => 1 );
170 has 'gey_2' => ( is => 'ro', isa => 'geyGene', coerce => 1 );
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.
176 As with most genes there are recessive and dominant genes. The bey2
177 brown gene is dominant to both blue and green. The gey green gene is
178 recessive to the brown bey gene and dominant to the blues. Finally,
179 the bey and gey2 blue genes are recessive to both brown and green.
185 if ( $self->bey2_1->color() eq 'brown'
186 or $self->bey2_2->color() eq 'brown' );
189 if ( $self->gey_1->color() eq 'green'
190 or $self->gey_2->color() eq 'green' );
195 To top it off, if I want to access 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 "$eye_color"
198 I'd get something like "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.
202 use overload '""' => \&color, fallback => 1;
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 EyeColor characteristics to
208 create a new EyeColor that is derived in a similar manner as
209 the gene selection in human reproduction.
211 use overload '+' => \&_overload_add, fallback => 1;
214 my ( $one, $two ) = @_;
216 my $one_bey2 = 'bey2_' . _rand2();
217 my $two_bey2 = 'bey2_' . _rand2();
219 my $one_gey = 'gey_' . _rand2();
220 my $two_gey = 'gey_' . _rand2();
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(),
231 return 1 + int( rand(2) );
234 What is happening here is we are overloading the addition
235 operator. When two eye color objects are added together
236 the _overload_add() method will be called with the two
237 objects on the left and right side of the + 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.
243 =head1 HUMAN EVOLUTION
245 Our original human class in the SYNOPSIS requires very little
246 change to support the new EyeColor characteristic. All we
247 need to do is define a new subtype called EyeColor, a new
248 attribute called eye_color, and just for the sake of simple code
249 we'll coerce an arrayref of colors in to an EyeColor object.
251 use List::MoreUtils qw( zip );
255 => where { $_->isa('Human::EyeColor') };
259 => via { my @genes = qw( bey2_1 bey2_2 gey_1 gey_2 );
260 return Human::EyeColor->new( zip( @genes, @$_ ) ); };
263 ( is => 'ro', isa => 'EyeColor', coerce => 1, required => 1 );
265 And then in the _overload_add() of the Human class we modify
266 the creation of the child object to include the addition of
267 the mother and father's eye colors.
271 eye_color => ( $one->eye_color() + $two->eye_color() ),
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.
282 If you want to get your hands on this code all combined together, and
283 working, download the Moose tarball and look at "t/000_recipes/012_genes.t".
287 Has this been a real project we'd probably want to:
291 =item Better Randomization with Crypt::Random
293 =item Characteristic Base Class
297 =item More Characteristics
299 =item Artificial Life
305 Aran Clary Deltac <bluefeet@cpan.org>
309 This work is licensed under a Creative Commons Attribution 3.0 Unported License.
311 License details are at: L<http://creativecommons.org/licenses/by/3.0/>