X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FCookbook%2FBasics%2FRecipe9.pod;h=a6fdf36d6a76f5272ea4c3c5072bc77bef7db7d7;hb=400e15966b814f14c2422b54a081bb8583caf691;hp=a73748ebf2e6f3651bf8bcac05e4ec2381f6e314;hpb=021b8139fcacfbd1c0d4dc26e07936457f1ba12b;p=gitmo%2FMoose.git diff --git a/lib/Moose/Cookbook/Basics/Recipe9.pod b/lib/Moose/Cookbook/Basics/Recipe9.pod index a73748e..a6fdf36 100644 --- a/lib/Moose/Cookbook/Basics/Recipe9.pod +++ b/lib/Moose/Cookbook/Basics/Recipe9.pod @@ -1,210 +1,265 @@ +package Moose::Cookbook::Basics::Recipe9; -=pod +# ABSTRACT: Operator overloading, subtypes, and coercion + +__END__ -=head1 NAME -Moose::Cookbook::Basics::Recipe9 - Builder methods and lazy_build +=pod =head1 SYNOPSIS - package BinaryTree; + package Human; + use Moose; + use Moose::Util::TypeConstraints; - has 'node' => (is => 'rw', isa => 'Any'); + subtype 'Gender' + => as 'Str' + => where { $_ =~ m{^[mf]$}s }; - has 'parent' => ( - is => 'rw', - isa => 'BinaryTree', - predicate => 'has_parent', - weak_ref => 1, - ); + has 'gender' => ( is => 'ro', isa => 'Gender', required => 1 ); - has 'left' => ( - is => 'rw', - isa => 'BinaryTree', - predicate => 'has_left', - lazy => 1, - builder => '_build_child_tree', - ); + has 'mother' => ( is => 'ro', isa => 'Human' ); + has 'father' => ( is => 'ro', isa => 'Human' ); - has 'right' => ( - is => 'rw', - isa => 'BinaryTree', - predicate => 'has_right', - lazy => 1, - builder => '_build_child_tree', - ); + 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() ); - before 'right', 'left' => sub { - my ($self, $tree) = @_; - $tree->parent($self) if defined $tree; - }; + my ( $mother, $father ) + = ( $one->gender eq 'f' ? ( $one, $two ) : ( $two, $one ) ); - sub _build_child_tree { - my $self = shift; + my $gender = 'f'; + $gender = 'm' if ( rand() >= 0.5 ); - return BinaryTree->new( parent => $self ); + return Human->new( + gender => $gender, + mother => $mother, + father => $father, + ); } =head1 DESCRIPTION -If you've already read L, then this example -should look awfully familiar. In fact, all we've done here is replace -the attribute C with a C method. +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). -In this particular case, the C and C options act in -exactly the same way. When the C or C attribute get -method is called, Moose will call the builder method to initialize the -attribute. +=head1 INTRODUCTION -Note that Moose calls the builder method I. Here's an example in code: +Our C 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. - my $tree = BinaryTree->new(); +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. - my $left = $tree->left(); +=head2 What is Operator Overloading? -At this point, Moose will call C<< $tree->_build_child_tree() >> in -order to populate the C attribute. If we had passed C to -the original constructor, the builer would not be called. +Overloading is I a Moose-specific feature. It's a general OO +concept that is implemented in Perl with the C +pragma. Overloading lets objects do something sane when used with +Perl's built in operators, like addition (C<+>) or when used as a +string. -=head2 Subclassable +In this example we overload addition so we can write code like +C<$child = $mother + $father>. -There are some differences between C and C. Because -C is called I, it goes through Perl's normal -inheritance system. This means that builder methods are both -inheritable and overrideable. +=head1 GENES -For example, we might make a C subclass: +There are many genes which affect eye color, but there are two which +are most important, I and I. We will start by making a +class for each gene. - package TrinaryTree; - use Moose; +=head2 Human::Gene::bey2 - extends 'BinaryTree'; + package Human::Gene::bey2; - has 'middle' => ( - is => 'rw', - isa => 'BinaryTree', - predicate => 'has_middle', - lazy => 1, - builder => '_build_child_tree', - ); + use Moose; + use Moose::Util::TypeConstraints; -This doesn't quite work though. If you look closely at the -C<_build_child_tree> method defined in C, you'll notice -that it hard-codes a class name. Naughty us! + type 'bey2_color' => where { $_ =~ m{^(?:brown|blue)$} }; -Also, as a bonus, we'll pass C<@_> through, so subclasses can override -the method to pass additional options to the constructor. + has 'color' => ( is => 'ro', isa => 'bey2_color' ); -Good object-oriented code should allow itself to be subclassed -gracefully. Let's tweak C<_build_child_tree>: +This class is trivial, We have a type constraint for the allowed +colors, and a C attribute. - sub _build_child_tree { - my $self = shift; +=head2 Human::Gene::gey - return (ref $self)->new( parent => $self, @_ ); - } + package Human::Gene::gey; -Now C<_build_child_tree> can be gracefully inherited and overridden. + use Moose; + use Moose::Util::TypeConstraints; -=head2 Composable + type 'gey_color' => where { $_ =~ m{^(?:green|blue)$} }; -There's more to builders than just subclassing, though. The fact that -builders are called by name also makes them suitable for use in a -role. + has 'color' => ( is => 'ro', isa => 'gey_color' ); - package HasAnimal; - use Moose::Role; +This is nearly identical to the C class, except +that the I gene allows for different colors. - requires '_build_animal'; +=head1 EYE COLOR - has 'animal' => ( - is => 'ro', - isa => 'Animal', - lazy => 1, - builder => '_build_animal', - ); +We could just give add four attributes (two of each gene) to the +C class, but this is a bit messy. Instead, we'll abstract the +genes into a container class, C. Then a C can +have a single C attribute. -This role provides an animal attribute, but requires that the consumer -of the role provide a builder method it. + package Human::EyeColor; - package CatLover; 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. - with 'HasAnimal'; +We also need a method to calculate the actual eye color that results +from a set of genes. The I brown gene is dominant over both blue +and green. The I green gene dominant over blue. - sub _build_animal { - return Cat->new(); + 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'; } -=head2 The lazy_build shortcut +We'd like to be able to treat a C object as a string, +so we define a string overloading for the class: -The C attribute parameter can be used as sugar to specify -a whole bunch of options at once. + use overload '""' => \&color, fallback => 1; - has 'animal' => ( - is => 'ro', - isa => 'Animal', - lazy_build => 1, - ); +Finally, we need to define overloading for addition. That way we can +add together to C 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 ) = @_; -This is a shorthand for this: + 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) ); + } - has 'animal' => ( - is => 'ro', - isa => 'Animal', - required => 1, - lazy => 1, - builder => '_build_animal', - predicate => 'has_animal', - clearer => 'clear_animal', +When two eye color objects are added together the C<_overload_add()> +method will be passed two C objects. These are the +left and right side operands for the C<+> operator. This method +returns a new C object. + +=head1 ADDING EYE COLOR TO Cs + +Our original C class requires just a few changes to incorporate +our new C 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, ); -If your attribute starts with an underscore, Moose is smart and will -do the right thing with the C and C, making them -both start with an underscore. The C method I starts -with an underscore, since you will want this to be private the vast -majority of the time. +We also need to modify C<_overload_add()> in the C class to +account for eye color: -Note that the C method name is created by simply taking -"_build_" and appending the attribute name. This means that attributes -with a leading underscore like C<_animal> end up with a builder named -C<_build__animal>. + return Human->new( + gender => $gender, + eye_color => ( $one->eye_color() + $two->eye_color() ), + mother => $mother, + father => $father, + ); =head1 CONCLUSION -The C option is a more OO-friendly version of the C -functionality. It also has the property of separating out the code -into a separate well-defined method. This alone makes it valuable. It -is quite ugly to jam a long default code reference into your attribute -definition. +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 pragma. + +To see all the code we created together, take a look at +F. -Here are some good rules for determining when to use C vs -C. +=head1 NEXT STEPS -If the default value is a simple scalar that only needs to be -calculated once (or a constant), use C. +Had this been a real project we'd probably want: -If the default value is an empty reference that needs to be wrapped in -a coderef like C, use C. +=over 4 -Otherwise, use C. +=item Better Randomization with Crypt::Random -This ensures that your classes are easily subclassable, and also helps -keep crufty code out of your attribute definition blocks. +=item Characteristic Base Class -=head1 AUTHOR +=item Mutating Genes -Dave Rolsky Eautarch@urth.orgE +=item More Characteristics -=head1 COPYRIGHT AND LICENSE +=item Artificial Life -Copyright 2006-2008 by Infinity Interactive, Inc. +=back -L +=head1 LICENSE -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. +This work is licensed under a Creative Commons Attribution 3.0 Unported License. + +License details are at: L =cut +