[gitmo/Moose.git] / lib / Moose / Cookbook / Basics / Recipe9.pod


=pod

=head1 NAME

Moose::Cookbook::Basics::Recipe9 - Operator overloading, subtypes, and coercion

=head1 SYNOPSIS

  package Human;

  use Moose;
  use Moose::Util::TypeConstraints;

  subtype 'Gender'
      => as 'Str'
      => where { $_ =~ m{^[mf]$}s };

  has 'gender' => ( is => 'ro', isa => 'Gender', required => 1 );

  has 'mother' => ( is => 'ro', isa => 'Human' );
  has 'father' => ( is => 'ro', isa => 'Human' );

  use overload '+' => \&_overload_add, fallback => 1;

  sub _overload_add {
      my ( $one, $two ) = @_;

      die('Only male and female humans may create children')
          if ( $one->gender() eq $two->gender() );

      my ( $mother, $father )
          = ( $one->gender eq 'f' ? ( $one, $two ) : ( $two, $one ) );

      my $gender = 'f';
      $gender = 'm' if ( rand() >= 0.5 );

      return Human->new(
          gender => $gender,
          mother => $mother,
          father => $father,
      );
  }

=head1 DESCRIPTION

This Moose cookbook recipe shows how operator overloading, coercion,
and sub types can be used to mimic the human reproductive system
(well, the selection of genes at least).

=head1 INTRODUCTION

Our C<Human> class uses operator overloading to allow us to "add" two
humans together and produce a child. Our implementation does require
that the two objects be of opposite genders. Remember, we're talking
about biological reproduction, not marriage.

While this example works as-is, we can take it a lot further by adding
genes into the mix. We'll add the two genes that control eye color,
and use overloading to combine the genes from the parent to model the
biology.

=head2 What is Operator Overloading?

Overloading is I<not> a Moose-specific feature. It's a general OO
concept that is implemented in Perl with the C<overload>
pragma. Overloading lets objects do something sane when used with
Perl's built in operators, like addition (C<+>) or when used as a
string.

In this example we overload addition so we can write code like
C<$child = $mother + $father>.

=head1 GENES

There are many genes which affect eye color, but there are two which
are most important, I<gey> and I<bey2>. We will start by making a
class for each gene.

=head2 Human::Gene::bey2

  package Human::Gene::bey2;

  use Moose;
  use Moose::Util::TypeConstraints;

  type 'bey2_color' => where { $_ =~ m{^(?:brown|blue)$} };

  has 'color' => ( is => 'ro', isa => 'bey2_color' );

This class is trivial, We have a type constraint for the allowed
colors, and a C<color> attribute.

=head2 Human::Gene::gey

  package Human::Gene::gey;

  use Moose;
  use Moose::Util::TypeConstraints;

  type 'gey_color' => where { $_ =~ m{^(?:green|blue)$} };

  has 'color' => ( is => 'ro', isa => 'gey_color' );

This is nearly identical to the C<Humane::Gene::bey2> class, except
that the I<gey> gene allows for different colors.

=head1 EYE COLOR

We could just give add four attributes (two of each gene) to the
C<Human> class, but this is a bit messy. Instead, we'll abstract the
genes into a container class, C<Human::EyeColor>. Then a C<Human> can
have a single C<eye_color> attribute.

  package Human::EyeColor;

  use Moose;
  use Moose::Util::TypeConstraints;

  coerce 'Human::Gene::bey2'
      => from 'Str'
          => via { Human::Gene::bey2->new( color => $_ ) };

  coerce 'Human::Gene::gey'
      => from 'Str'
          => via { Human::Gene::gey->new( color => $_ ) };

  has [qw( bey2_1 bey2_2 )] =>
      ( is => 'ro', isa => 'Human::Gene::bey2', coerce => 1 );

  has [qw( gey_1 gey_2 )] =>
      ( is => 'ro', isa => 'Human::Gene::gey', coerce => 1 );

The eye color class has two of each type of gene. We've also created a
coercion for each class that coerces a string into a new object. Note
that a coercion will fail if it attempts to coerce a string like
"indigo", because that is not a valid color for either type of gene.

As an aside, you can see that we can define several identical
attributes at once by supply an array reference of names as the first
argument to C<has>.

We also need a method to calculate the actual eye color that results
from a set of genes. The I<bey2> brown gene is dominant over both blue
and green. The I<gey> green gene dominant over blue.

  sub color {
      my ($self) = @_;

      return 'brown'
          if ( $self->bey2_1->color() eq 'brown'
          or $self->bey2_2->color() eq 'brown' );

      return 'green'
          if ( $self->gey_1->color() eq 'green'
          or $self->gey_2->color() eq 'green' );

      return 'blue';
  }

We'd like to be able to treat a C<Human::EyeColor> object as a string,
so we define a string overloading for the class:

  use overload '""' => \&color, fallback => 1;

Finally, we need to define overloading for addition. That way we can
add together to C<Human::EyeColor> objects and get a new one with a
new (genetically correct) eye color.

  use overload '+' => \&_overload_add, fallback => 1;

  sub _overload_add {
      my ( $one, $two ) = @_;

      my $one_bey2 = 'bey2_' . _rand2();
      my $two_bey2 = 'bey2_' . _rand2();

      my $one_gey = 'gey_' . _rand2();
      my $two_gey = 'gey_' . _rand2();

      return Human::EyeColor->new(
          bey2_1 => $one->$one_bey2->color(),
          bey2_2 => $two->$two_bey2->color(),
          gey_1  => $one->$one_gey->color(),
          gey_2  => $two->$two_gey->color(),
      );
  }

  sub _rand2 {
      return 1 + int( rand(2) );
  }

When two eye color objects are added together the C<_overload_add()>
method will be passed two C<Human::EyeColor> objects. These are the
left and right side operands for the C<+> operator. This method
returns a new C<Human::EyeColor> object.

=head1 ADDING EYE COLOR TO C<Human>s

Our original C<Human> class requires just a few changes to incorporate
our new C<Human::EyeColor> class.

  use List::MoreUtils qw( zip );

  coerce 'Human::EyeColor'
      => from 'ArrayRef'
      => via { my @genes = qw( bey2_1 bey2_2 gey_1 gey_2 );
               return Human::EyeColor->new( zip( @genes, @{$_} ) ); };

  has 'eye_color' => (
      is       => 'ro',
      isa      => 'Human::EyeColor',
      coerce   => 1,
      required => 1,
  );

We also need to modify C<_overload_add()> in the C<Human> class to
account for eye color:

  return Human->new(
      gender    => $gender,
      eye_color => ( $one->eye_color() + $two->eye_color() ),
      mother    => $mother,
      father    => $father,
  );

=head1 CONCLUSION

The three techniques we used, overloading, subtypes, and coercion,
combine to provide a powerful interface.

If you'd like to learn more about overloading, please read the
documentation for the L<overload> pragma.

To see all the code we created together, take a look at
F<t/000_recipes/basics/010_genes.t>.

=head1 NEXT STEPS

Has this been a real project we'd probably want to:

=over 4

=item Better Randomization with Crypt::Random

=item Characteristic Base Class

=item Mutating Genes

=item More Characteristics

=item Artificial Life

=back

=head1 AUTHORS

Aran Clary Deltac <bluefeet@cpan.org>

Dave Rolsky E<lt>autarch@urth.orgE<gt>

=head1 LICENSE

This work is licensed under a Creative Commons Attribution 3.0 Unported License.

License details are at: L<http://creativecommons.org/licenses/by/3.0/>

=cut
Commit	Line	Data
ceb8945d	1
	2	=pod
	3
	4	=head1 NAME
	5
ec65165a	6	Moose::Cookbook::Basics::Recipe9 - Operator overloading, subtypes, and coercion
ceb8945d	7
	8	=head1 SYNOPSIS
	9
1f476b5f	10	package Human;
1f476b5f	11
ceb8945d	12	use Moose;
1f476b5f	13	use Moose::Util::TypeConstraints;
ceb8945d	14
1f476b5f	15	subtype 'Gender'
	16	=> as 'Str'
	17	=> where { $_ =~ m{^[mf]$}s };
ceb8945d	18
1f476b5f	19	has 'gender' => ( is => 'ro', isa => 'Gender', required => 1 );
ceb8945d	20
1f476b5f	21	has 'mother' => ( is => 'ro', isa => 'Human' );
1f476b5f	22	has 'father' => ( is => 'ro', isa => 'Human' );
ceb8945d	23
1f476b5f	24	use overload '+' => \&_overload_add, fallback => 1;
	25
	26	sub _overload_add {
	27	my ( $one, $two ) = @_;
ceb8945d	28
1f476b5f	29	die('Only male and female humans may create children')
1f476b5f	30	if ( $one->gender() eq $two->gender() );
ceb8945d	31
1f476b5f	32	my ( $mother, $father )
1f476b5f	33	= ( $one->gender eq 'f' ? ( $one, $two ) : ( $two, $one ) );
ceb8945d	34
1f476b5f	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	);
ceb8945d	43	}
	44
	45	=head1 DESCRIPTION
	46
1f476b5f	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).
ceb8945d	50
1f476b5f	51	=head1 INTRODUCTION
e89d3090	52
1f476b5f	53	Our C<Human> class uses operator overloading to allow us to "add" two
	54	humans together and produce a child. Our implementation does require
	55	that the two objects be of opposite genders. Remember, we're talking
	56	about biological reproduction, not marriage.
e89d3090	57
1f476b5f	58	While this example works as-is, we can take it a lot further by adding
	59	genes into the mix. We'll add the two genes that control eye color,
	60	and use overloading to combine the genes from the parent to model the
	61	biology.
e89d3090	62
1f476b5f	63	=head2 What is Operator Overloading?
e89d3090	64
1f476b5f	65	Overloading is I<not> a Moose-specific feature. It's a general OO
	66	concept that is implemented in Perl with the C<overload>
	67	pragma. Overloading lets objects do something sane when used with
	68	Perl's built in operators, like addition (C<+>) or when used as a
	69	string.
ceb8945d	70
1f476b5f	71	In this example we overload addition so we can write code like
1f476b5f	72	C<$child = $mother + $father>.
ceb8945d	73
1f476b5f	74	=head1 GENES
ceb8945d	75
1f476b5f	76	There are many genes which affect eye color, but there are two which
	77	are most important, I<gey> and I<bey2>. We will start by making a
	78	class for each gene.
ceb8945d	79
1f476b5f	80	=head2 Human::Gene::bey2
	81
	82	package Human::Gene::bey2;
	83
	84	use Moose;
	85	use Moose::Util::TypeConstraints;
	86
	87	type 'bey2_color' => where { $_ =~ m{^(?:brown\|blue)$} };
	88
	89	has 'color' => ( is => 'ro', isa => 'bey2_color' );
	90
	91	This class is trivial, We have a type constraint for the allowed
	92	colors, and a C<color> attribute.
	93
	94	=head2 Human::Gene::gey
	95
	96	package Human::Gene::gey;
	97
	98	use Moose;
	99	use Moose::Util::TypeConstraints;
	100
	101	type 'gey_color' => where { $_ =~ m{^(?:green\|blue)$} };
	102
	103	has 'color' => ( is => 'ro', isa => 'gey_color' );
	104
	105	This is nearly identical to the C<Humane::Gene::bey2> class, except
	106	that the I<gey> gene allows for different colors.
	107
	108	=head1 EYE COLOR
	109
	110	We could just give add four attributes (two of each gene) to the
	111	C<Human> class, but this is a bit messy. Instead, we'll abstract the
	112	genes into a container class, C<Human::EyeColor>. Then a C<Human> can
	113	have a single C<eye_color> attribute.
	114
	115	package Human::EyeColor;
	116
	117	use Moose;
	118	use Moose::Util::TypeConstraints;
	119
	120	coerce 'Human::Gene::bey2'
	121	=> from 'Str'
	122	=> via { Human::Gene::bey2->new( color => $_ ) };
	123
	124	coerce 'Human::Gene::gey'
	125	=> from 'Str'
	126	=> via { Human::Gene::gey->new( color => $_ ) };
	127
	128	has [qw( bey2_1 bey2_2 )] =>
	129	( is => 'ro', isa => 'Human::Gene::bey2', coerce => 1 );
	130
	131	has [qw( gey_1 gey_2 )] =>
	132	( is => 'ro', isa => 'Human::Gene::gey', coerce => 1 );
	133
	134	The eye color class has two of each type of gene. We've also created a
	135	coercion for each class that coerces a string into a new object. Note
	136	that a coercion will fail if it attempts to coerce a string like
	137	"indigo", because that is not a valid color for either type of gene.
	138
	139	As an aside, you can see that we can define several identical
	140	attributes at once by supply an array reference of names as the first
	141	argument to C<has>.
	142
	143	We also need a method to calculate the actual eye color that results
144	from a set of genes. The I<bey2> brown gene is dominant over both blue
145	and green. The I<gey> green gene dominant over blue.
146
147	sub color {
148	my ($self) = @_;
149
150	return 'brown'
151	if ( $self->bey2_1->color() eq 'brown'
152	or $self->bey2_2->color() eq 'brown' );
ceb8945d	153
1f476b5f	154	return 'green'
	155	if ( $self->gey_1->color() eq 'green'
	156	or $self->gey_2->color() eq 'green' );
ceb8945d	157
1f476b5f	158	return 'blue';
	159	}
	160
	161	We'd like to be able to treat a C<Human::EyeColor> object as a string,
	162	so we define a string overloading for the class:
	163
	164	use overload '""' => \&color, fallback => 1;
	165
	166	Finally, we need to define overloading for addition. That way we can
	167	add together to C<Human::EyeColor> objects and get a new one with a
	168	new (genetically correct) eye color.
	169
	170	use overload '+' => \&_overload_add, fallback => 1;
	171
	172	sub _overload_add {
	173	my ( $one, $two ) = @_;
	174
	175	my $one_bey2 = 'bey2_' . _rand2();
	176	my $two_bey2 = 'bey2_' . _rand2();
	177
	178	my $one_gey = 'gey_' . _rand2();
	179	my $two_gey = 'gey_' . _rand2();
	180
	181	return Human::EyeColor->new(
	182	bey2_1 => $one->$one_bey2->color(),
	183	bey2_2 => $two->$two_bey2->color(),
	184	gey_1 => $one->$one_gey->color(),
	185	gey_2 => $two->$two_gey->color(),
	186	);
	187	}
	188
	189	sub _rand2 {
	190	return 1 + int( rand(2) );
	191	}
	192
	193	When two eye color objects are added together the C<_overload_add()>
	194	method will be passed two C<Human::EyeColor> objects. These are the
	195	left and right side operands for the C<+> operator. This method
	196	returns a new C<Human::EyeColor> object.
	197
	198	=head1 ADDING EYE COLOR TO C<Human>s
	199
	200	Our original C<Human> class requires just a few changes to incorporate
	201	our new C<Human::EyeColor> class.
	202
	203	use List::MoreUtils qw( zip );
	204
	205	coerce 'Human::EyeColor'
	206	=> from 'ArrayRef'
	207	=> via { my @genes = qw( bey2_1 bey2_2 gey_1 gey_2 );
	208	return Human::EyeColor->new( zip( @genes, @{$_} ) ); };
	209
	210	has 'eye_color' => (
	211	is => 'ro',
	212	isa => 'Human::EyeColor',
	213	coerce => 1,
	214	required => 1,
ceb8945d	215	);
ceb8945d	216
1f476b5f	217	We also need to modify C<_overload_add()> in the C<Human> class to
1f476b5f	218	account for eye color:
ceb8945d	219
1f476b5f	220	return Human->new(
	221	gender => $gender,
	222	eye_color => ( $one->eye_color() + $two->eye_color() ),
	223	mother => $mother,
	224	father => $father,
	225	);
398e7b2c	226
ceb8945d	227	=head1 CONCLUSION
ceb8945d	228
1f476b5f	229	The three techniques we used, overloading, subtypes, and coercion,
1f476b5f	230	combine to provide a powerful interface.
09b815aa	231
1f476b5f	232	If you'd like to learn more about overloading, please read the
1f476b5f	233	documentation for the L<overload> pragma.
ceb8945d	234
1f476b5f	235	To see all the code we created together, take a look at
	236	F<t/000_recipes/basics/010_genes.t>.
	237
	238	=head1 NEXT STEPS
	239
	240	Has this been a real project we'd probably want to:
	241
	242	=over 4
	243
	244	=item Better Randomization with Crypt::Random
	245
	246	=item Characteristic Base Class
ceb8945d	247
1f476b5f	248	=item Mutating Genes
ceb8945d	249
1f476b5f	250	=item More Characteristics
ceb8945d	251
1f476b5f	252	=item Artificial Life
ceb8945d	253
1f476b5f	254	=back
	255
	256	=head1 AUTHORS
	257
	258	Aran Clary Deltac <bluefeet@cpan.org>
	259
	260	Dave Rolsky E<lt>autarch@urth.orgE<gt>
	261
	262	=head1 LICENSE
	263
	264	This work is licensed under a Creative Commons Attribution 3.0 Unported License.
	265
	266	License details are at: L<http://creativecommons.org/licenses/by/3.0/>
ceb8945d	267
ceb8945d	268	=cut
1f476b5f	269