1# PODNAME: Moose::Cookbook::Basics::Genome_OverloadingSubtypesAndCoercion
2# ABSTRACT: Operator overloading, subtypes, and coercion
3
4__END__
5
6=pod
7
8=encoding UTF-8
9
10=head1 NAME
11
12Moose::Cookbook::Basics::Genome_OverloadingSubtypesAndCoercion - Operator overloading, subtypes, and coercion
13
14=head1 VERSION
15
16version 2.2201
17
18=head1 SYNOPSIS
19
20  package Human;
21
22  use Moose;
23  use Moose::Util::TypeConstraints;
24
25  subtype 'Sex'
26      => as 'Str'
27      => where { $_ =~ m{^[mf]$}s };
28
29  has 'sex'    => ( is => 'ro', isa => 'Sex', required => 1 );
30
31  has 'mother' => ( is => 'ro', isa => 'Human' );
32  has 'father' => ( is => 'ro', isa => 'Human' );
33
34  use overload '+' => \&_overload_add, fallback => 1;
35
36  sub _overload_add {
37      my ( $one, $two ) = @_;
38
39      die('Only male and female humans may create children')
40          if ( $one->sex() eq $two->sex() );
41
42      my ( $mother, $father )
43          = ( $one->sex eq 'f' ? ( $one, $two ) : ( $two, $one ) );
44
45      my $sex = 'f';
46      $sex = 'm' if ( rand() >= 0.5 );
47
48      return Human->new(
49          sex    => $sex,
50          mother => $mother,
51          father => $father,
52      );
53  }
54
55=head1 DESCRIPTION
56
57This Moose cookbook recipe shows how operator overloading, coercion,
58and subtypes can be used to mimic the human reproductive system
59(well, the selection of genes at least).
60
61=head1 INTRODUCTION
62
63Our C<Human> class uses operator overloading to allow us to "add" two
64humans together and produce a child. Our implementation does require
65that the two objects be of opposite sex. Remember, we're talking
66about biological reproduction, not marriage.
67
68While this example works as-is, we can take it a lot further by adding
69genes into the mix. We'll add the two genes that control eye color,
70and use overloading to combine the genes from the parent to model the
71biology.
72
73=head2 What is Operator Overloading?
74
75Overloading is I<not> a Moose-specific feature. It's a general OO
76concept that is implemented in Perl with the C<overload>
77pragma. Overloading lets objects do something sane when used with
78Perl's built in operators, like addition (C<+>) or when used as a
79string.
80
81In this example we overload addition so we can write code like
82C<$child = $mother + $father>.
83
84=head1 GENES
85
86There are many genes which affect eye color, but there are two which
87are most important, I<gey> and I<bey2>. We will start by making a
88class for each gene.
89
90=head2 Human::Gene::bey2
91
92  package Human::Gene::bey2;
93
94  use Moose;
95  use Moose::Util::TypeConstraints;
96
97  type 'bey2_color' => where { $_ =~ m{^(?:brown|blue)$} };
98
99  has 'color' => ( is => 'ro', isa => 'bey2_color' );
100
101This class is trivial. We have a type constraint for the allowed
102colors, and a C<color> attribute.
103
104=head2 Human::Gene::gey
105
106  package Human::Gene::gey;
107
108  use Moose;
109  use Moose::Util::TypeConstraints;
110
111  type 'gey_color' => where { $_ =~ m{^(?:green|blue)$} };
112
113  has 'color' => ( is => 'ro', isa => 'gey_color' );
114
115This is nearly identical to the C<Humane::Gene::bey2> class, except
116that the I<gey> gene allows for different colors.
117
118=head1 EYE COLOR
119
120We could just give four attributes (two of each gene) to the
121C<Human> class, but this is a bit messy. Instead, we'll abstract the
122genes into a container class, C<Human::EyeColor>. Then a C<Human> can
123have a single C<eye_color> attribute.
124
125  package Human::EyeColor;
126
127  use Moose;
128  use Moose::Util::TypeConstraints;
129
130  coerce 'Human::Gene::bey2'
131      => from 'Str'
132          => via { Human::Gene::bey2->new( color => $_ ) };
133
134  coerce 'Human::Gene::gey'
135      => from 'Str'
136          => via { Human::Gene::gey->new( color => $_ ) };
137
138  has [qw( bey2_1 bey2_2 )] =>
139      ( is => 'ro', isa => 'Human::Gene::bey2', coerce => 1 );
140
141  has [qw( gey_1 gey_2 )] =>
142      ( is => 'ro', isa => 'Human::Gene::gey', coerce => 1 );
143
144The eye color class has two of each type of gene. We've also created a
145coercion for each class that coerces a string into a new object. Note
146that a coercion will fail if it attempts to coerce a string like
147"indigo", because that is not a valid color for either type of gene.
148
149As an aside, you can see that we can define several identical
150attributes at once by supplying an array reference of names as the first
151argument to C<has>.
152
153We also need a method to calculate the actual eye color that results
154from a set of genes. The I<bey2> brown gene is dominant over both blue
155and green. The I<gey> green gene is dominant over blue.
156
157  sub color {
158      my ($self) = @_;
159
160      return 'brown'
161          if ( $self->bey2_1->color() eq 'brown'
162          or $self->bey2_2->color() eq 'brown' );
163
164      return 'green'
165          if ( $self->gey_1->color() eq 'green'
166          or $self->gey_2->color() eq 'green' );
167
168      return 'blue';
169  }
170
171We'd like to be able to treat a C<Human::EyeColor> object as a string,
172so we define a string overloading for the class:
173
174  use overload '""' => \&color, fallback => 1;
175
176Finally, we need to define overloading for addition. That way we can
177add together two C<Human::EyeColor> objects and get a new one with a
178new (genetically correct) eye color.
179
180  use overload '+' => \&_overload_add, fallback => 1;
181
182  sub _overload_add {
183      my ( $one, $two ) = @_;
184
185      my $one_bey2 = 'bey2_' . _rand2();
186      my $two_bey2 = 'bey2_' . _rand2();
187
188      my $one_gey = 'gey_' . _rand2();
189      my $two_gey = 'gey_' . _rand2();
190
191      return Human::EyeColor->new(
192          bey2_1 => $one->$one_bey2->color(),
193          bey2_2 => $two->$two_bey2->color(),
194          gey_1  => $one->$one_gey->color(),
195          gey_2  => $two->$two_gey->color(),
196      );
197  }
198
199  sub _rand2 {
200      return 1 + int( rand(2) );
201  }
202
203When two eye color objects are added together, the C<_overload_add()>
204method will be passed two C<Human::EyeColor> objects. These are the
205left and right side operands for the C<+> operator. This method
206returns a new C<Human::EyeColor> object.
207
208=head1 ADDING EYE COLOR TO C<Human>s
209
210Our original C<Human> class requires just a few changes to incorporate
211our new C<Human::EyeColor> class.
212
213  use List::Util 1.56 qw( mesh );
214
215  coerce 'Human::EyeColor'
216      => from 'ArrayRef'
217      => via { my @genes = qw( bey2_1 bey2_2 gey_1 gey_2 );
218               return Human::EyeColor->new( mesh ( \@genes, $_ ) ); };
219
220  has 'eye_color' => (
221      is       => 'ro',
222      isa      => 'Human::EyeColor',
223      coerce   => 1,
224      required => 1,
225  );
226
227We also need to modify C<_overload_add()> in the C<Human> class to
228account for eye color:
229
230  return Human->new(
231      sex       => $sex,
232      eye_color => ( $one->eye_color() + $two->eye_color() ),
233      mother    => $mother,
234      father    => $father,
235  );
236
237=head1 CONCLUSION
238
239The three techniques we used, overloading, subtypes, and coercion,
240combine to provide a powerful interface.
241
242If you'd like to learn more about overloading, please read the
243documentation for the L<overload> pragma.
244
245To see all the code we created together, take a look at
246F<t/recipes/basics_genome_overloadingsubtypesandcoercion.t>.
247
248=head1 NEXT STEPS
249
250Had this been a real project we'd probably want:
251
252=over 4
253
254=item Better Randomization with Crypt::Random
255
256=item Characteristic Base Class
257
258=item Mutating Genes
259
260=item More Characteristics
261
262=item Artificial Life
263
264=back
265
266=head1 AUTHORS
267
268=over 4
269
270=item *
271
272Stevan Little <stevan@cpan.org>
273
274=item *
275
276Dave Rolsky <autarch@urth.org>
277
278=item *
279
280Jesse Luehrs <doy@cpan.org>
281
282=item *
283
284Shawn M Moore <sartak@cpan.org>
285
286=item *
287
288יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
289
290=item *
291
292Karen Etheridge <ether@cpan.org>
293
294=item *
295
296Florian Ragwitz <rafl@debian.org>
297
298=item *
299
300Hans Dieter Pearcey <hdp@cpan.org>
301
302=item *
303
304Chris Prather <chris@prather.org>
305
306=item *
307
308Matt S Trout <mstrout@cpan.org>
309
310=back
311
312=head1 COPYRIGHT AND LICENSE
313
314This work is licensed under a Creative Commons Attribution 3.0 Unported License.
315
316License details are at: L<http://creativecommons.org/licenses/by/3.0/>
317
318=cut
319