Commit | Line | Data |
c2a0627f |
1 | |
2 | =pod |
3 | |
4 | =head1 NAME |
5 | |
58d129ba |
6 | Moose::Cookbook::Basics::Recipe10 - Operator overloading, subtypes, and coercion |
c2a0627f |
7 | |
8 | =head1 SYNOPSIS |
9 | |
10 | package Human; |
c765b254 |
11 | |
c2a0627f |
12 | use Moose; |
13 | use Moose::Util::TypeConstraints; |
c765b254 |
14 | |
c2a0627f |
15 | subtype 'Gender' |
16 | => as 'Str' |
17 | => where { $_ =~ m{^[mf]$}s }; |
c765b254 |
18 | |
c2a0627f |
19 | has 'gender' => ( is => 'ro', isa => 'Gender', required => 1 ); |
c765b254 |
20 | |
c2a0627f |
21 | has 'mother' => ( is => 'ro', isa => 'Human' ); |
22 | has 'father' => ( is => 'ro', isa => 'Human' ); |
c765b254 |
23 | |
c2a0627f |
24 | use overload '+' => \&_overload_add, fallback => 1; |
c765b254 |
25 | |
c2a0627f |
26 | sub _overload_add { |
c765b254 |
27 | my ( $one, $two ) = @_; |
28 | |
c2a0627f |
29 | die('Only male and female humans may create children') |
c765b254 |
30 | if ( $one->gender() eq $two->gender() ); |
31 | |
32 | my ( $mother, $father ) |
33 | = ( $one->gender eq 'f' ? ( $one, $two ) : ( $two, $one ) ); |
34 | |
c2a0627f |
35 | my $gender = 'f'; |
c765b254 |
36 | $gender = 'm' if ( rand() >= 0.5 ); |
37 | |
c2a0627f |
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 | |
6549b0d1 |
54 | The example in the L</"SYNOPSIS"> outlines a very basic use of |
c2a0627f |
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 |
6549b0d1 |
67 | the most effect on eye color and each person carries two of each |
c2a0627f |
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 |
6549b0d1 |
79 | you want to overload and what method to call. See |
80 | L<overload> to see some good, basic, examples. |
c2a0627f |
81 | |
82 | =head2 Subtypes |
83 | |
84 | Moose comes with 21 default type constraints, as documented in |
6549b0d1 |
85 | L<Moose::Util::TypeConstraints>. C<Int>, C<Str>, and C<CodeRef> are |
c2a0627f |
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 |
021b8139 |
89 | is available in the L<Moose::Cookbook::Basics::Recipe4>. |
c2a0627f |
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 |
021b8139 |
98 | this can be found in L<Moose::Cookbook::Basics::Recipe5>. |
c2a0627f |
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 |
6549b0d1 |
104 | the most prominent role: I<gey> and I<bey2>. To get started let us |
c2a0627f |
105 | make classes for these genes. |
106 | |
107 | =head2 bey2 |
108 | |
109 | package Human::Gene::bey2; |
c765b254 |
110 | |
c2a0627f |
111 | use Moose; |
112 | use Moose::Util::TypeConstraints; |
c765b254 |
113 | |
c2a0627f |
114 | type 'bey2Color' => where { $_ =~ m{^(?:brown|blue)$}s }; |
c765b254 |
115 | |
c2a0627f |
116 | has 'color' => ( is => 'ro', isa => 'bey2Color' ); |
117 | |
6549b0d1 |
118 | This class is really simple. All we need to know about the I<bey2> |
c2a0627f |
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; |
c765b254 |
126 | |
c2a0627f |
127 | use Moose; |
128 | use Moose::Util::TypeConstraints; |
c765b254 |
129 | |
c2a0627f |
130 | type 'geyColor' => where { $_ =~ m{^(?:green|blue)$}s }; |
c765b254 |
131 | |
c2a0627f |
132 | has 'color' => ( is => 'ro', isa => 'geyColor' ); |
133 | |
6549b0d1 |
134 | The I<gey> gene is nearly identical to I<bey2>, except that it |
c2a0627f |
135 | has a green or blue variety. |
136 | |
137 | =head1 EYE COLOR |
138 | |
6549b0d1 |
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 |
c2a0627f |
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; |
c765b254 |
146 | |
c2a0627f |
147 | use Moose; |
148 | use Moose::Util::TypeConstraints; |
c765b254 |
149 | |
c2a0627f |
150 | subtype 'bey2Gene' |
151 | => as 'Object' |
152 | => where { $_->isa('Human::Gene::bey2') }; |
c765b254 |
153 | |
c2a0627f |
154 | coerce 'bey2Gene' |
155 | => from 'Str' |
156 | => via { Human::Gene::bey2->new( color => $_ ) }; |
c765b254 |
157 | |
c2a0627f |
158 | subtype 'geyGene' |
159 | => as 'Object' |
160 | => where { $_->isa('Human::Gene::gey') }; |
c765b254 |
161 | |
c2a0627f |
162 | coerce 'geyGene' |
163 | => from 'Str' |
164 | => via { Human::Gene::gey->new( color => $_ ) }; |
c765b254 |
165 | |
c2a0627f |
166 | has 'bey2_1' => ( is => 'ro', isa => 'bey2Gene', coerce => 1 ); |
167 | has 'bey2_2' => ( is => 'ro', isa => 'bey2Gene', coerce => 1 ); |
c765b254 |
168 | |
169 | has 'gey_1' => ( is => 'ro', isa => 'geyGene', coerce => 1 ); |
170 | has 'gey_2' => ( is => 'ro', isa => 'geyGene', coerce => 1 ); |
c2a0627f |
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 | |
6549b0d1 |
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. |
c2a0627f |
180 | |
181 | sub color { |
c765b254 |
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 | |
c2a0627f |
192 | return 'blue'; |
193 | } |
194 | |
6549b0d1 |
195 | To top it off, if I want to access C<color()>, I want to be really lazy |
c2a0627f |
196 | about it. Perl overloading supports the ability to overload the |
6549b0d1 |
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 |
c2a0627f |
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 |
6549b0d1 |
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 |
c2a0627f |
209 | the gene selection in human reproduction. |
210 | |
211 | use overload '+' => \&_overload_add, fallback => 1; |
c765b254 |
212 | |
c2a0627f |
213 | sub _overload_add { |
c765b254 |
214 | my ( $one, $two ) = @_; |
215 | |
c2a0627f |
216 | my $one_bey2 = 'bey2_' . _rand2(); |
217 | my $two_bey2 = 'bey2_' . _rand2(); |
c765b254 |
218 | |
c2a0627f |
219 | my $one_gey = 'gey_' . _rand2(); |
220 | my $two_gey = 'gey_' . _rand2(); |
c765b254 |
221 | |
c2a0627f |
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 | } |
c765b254 |
229 | |
c2a0627f |
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 |
6549b0d1 |
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. |
c2a0627f |
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 | |
6549b0d1 |
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. |
c2a0627f |
250 | |
251 | use List::MoreUtils qw( zip ); |
c765b254 |
252 | |
c2a0627f |
253 | subtype 'EyeColor' |
254 | => as 'Object' |
255 | => where { $_->isa('Human::EyeColor') }; |
c765b254 |
256 | |
c2a0627f |
257 | coerce 'EyeColor' |
258 | => from 'ArrayRef' |
c765b254 |
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 ); |
c2a0627f |
264 | |
6549b0d1 |
265 | And then in the C<_overload_add()> of the C<Human> class we modify |
c2a0627f |
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( |
c765b254 |
270 | gender => $gender, |
c2a0627f |
271 | eye_color => ( $one->eye_color() + $two->eye_color() ), |
c765b254 |
272 | mother => $mother, |
273 | father => $father, |
c2a0627f |
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 |
6549b0d1 |
283 | working, download the Moose tarball and look at |
284 | F<t/000_recipes/basics/010_genes.t>. |
c2a0627f |
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 | |