[Moose-commits] r7234 - Moose/trunk/lib/Moose/Cookbook/Basics
autarch at code2.0beta.co.uk
autarch at code2.0beta.co.uk
Tue Jan 6 05:32:40 GMT 2009
Author: autarch
Date: 2009-01-05 21:32:40 -0800 (Mon, 05 Jan 2009)
New Revision: 7234
Modified:
Moose/trunk/lib/Moose/Cookbook/Basics/Recipe10.pod
Moose/trunk/lib/Moose/Cookbook/Basics/Recipe3.pod
Moose/trunk/lib/Moose/Cookbook/Basics/Recipe5.pod
Moose/trunk/lib/Moose/Cookbook/Basics/Recipe7.pod
Log:
tidy code in pod for consistency, also tidy some text
Modified: Moose/trunk/lib/Moose/Cookbook/Basics/Recipe10.pod
===================================================================
--- Moose/trunk/lib/Moose/Cookbook/Basics/Recipe10.pod 2009-01-06 05:24:24 UTC (rev 7233)
+++ Moose/trunk/lib/Moose/Cookbook/Basics/Recipe10.pod 2009-01-06 05:32:40 UTC (rev 7234)
@@ -8,32 +8,33 @@
=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) = @_;
-
+ 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) );
-
+ 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);
-
+ $gender = 'm' if ( rand() >= 0.5 );
+
return Human->new(
gender => $gender,
mother => $mother,
@@ -106,12 +107,12 @@
=head2 bey2
package Human::Gene::bey2;
-
+
use Moose;
use Moose::Util::TypeConstraints;
-
+
type 'bey2Color' => where { $_ =~ m{^(?:brown|blue)$}s };
-
+
has 'color' => ( is => 'ro', isa => 'bey2Color' );
This class is really simple. All we need to know about the bey2
@@ -122,12 +123,12 @@
=head2 gey
package Human::Gene::gey;
-
+
use Moose;
use Moose::Util::TypeConstraints;
-
+
type 'geyColor' => where { $_ =~ m{^(?:green|blue)$}s };
-
+
has 'color' => ( is => 'ro', isa => 'geyColor' );
The gey gene is nearly identical to the bey2, except that it
@@ -142,32 +143,32 @@
characteristics that makes up a Human.
package Human::EyeColor;
-
+
use Moose;
use Moose::Util::TypeConstraints;
-
+
subtype 'bey2Gene'
=> as 'Object'
=> where { $_->isa('Human::Gene::bey2') };
-
+
coerce 'bey2Gene'
=> from 'Str'
=> via { Human::Gene::bey2->new( color => $_ ) };
-
+
subtype 'geyGene'
=> as 'Object'
=> where { $_->isa('Human::Gene::gey') };
-
+
coerce 'geyGene'
=> from 'Str'
=> via { Human::Gene::gey->new( color => $_ ) };
-
+
has 'bey2_1' => ( is => 'ro', isa => 'bey2Gene', coerce => 1 );
has 'bey2_2' => ( is => 'ro', isa => 'bey2Gene', coerce => 1 );
-
- has 'gey_1' => ( is => 'ro', isa => 'geyGene', coerce => 1 );
- has 'gey_2' => ( is => 'ro', isa => 'geyGene', coerce => 1 );
+ has 'gey_1' => ( is => 'ro', isa => 'geyGene', coerce => 1 );
+ has 'gey_2' => ( is => 'ro', isa => 'geyGene', coerce => 1 );
+
So, we now have a class that can hold the four genes that dictate
eye color. This isn't quite enough, as we also need to calculate
what the human's actual eye color is as a result of the genes.
@@ -178,10 +179,16 @@
the bey and gey2 blue genes are recessive to both brown and green.
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');
+ 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';
}
@@ -202,16 +209,16 @@
the gene selection in human reproduction.
use overload '+' => \&_overload_add, fallback => 1;
-
+
sub _overload_add {
- my ($one, $two) = @_;
-
+ 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(),
@@ -219,7 +226,7 @@
gey_2 => $two->$two_gey->color(),
);
}
-
+
sub _rand2 {
return 1 + int( rand(2) );
}
@@ -242,29 +249,28 @@
we'll coerce an arrayref of colors in to an EyeColor object.
use List::MoreUtils qw( zip );
-
+
subtype 'EyeColor'
=> as 'Object'
=> where { $_->isa('Human::EyeColor') };
-
+
coerce '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 => 'EyeColor', coerce => 1, required => 1 );
+ => via { my @genes = qw( bey2_1 bey2_2 gey_1 gey_2 );
+ return Human::EyeColor->new( zip( @genes, @$_ ) ); };
+ has 'eye_color' =>
+ ( is => 'ro', isa => 'EyeColor', coerce => 1, required => 1 );
+
And then in the _overload_add() of the Human class we modify
the creation of the child object to include the addition of
the mother and father's eye colors.
return Human->new(
- gender => $gender,
+ gender => $gender,
eye_color => ( $one->eye_color() + $two->eye_color() ),
- mother => $mother,
- father => $father,
+ mother => $mother,
+ father => $father,
);
=head1 CONCLUSION
Modified: Moose/trunk/lib/Moose/Cookbook/Basics/Recipe3.pod
===================================================================
--- Moose/trunk/lib/Moose/Cookbook/Basics/Recipe3.pod 2009-01-06 05:24:24 UTC (rev 7233)
+++ Moose/trunk/lib/Moose/Cookbook/Basics/Recipe3.pod 2009-01-06 05:32:40 UTC (rev 7234)
@@ -9,35 +9,35 @@
package BinaryTree;
use Moose;
-
- has 'node' => (is => 'rw', isa => 'Any');
-
+
+ has 'node' => ( is => 'rw', isa => 'Any' );
+
has 'parent' => (
is => 'rw',
- isa => 'BinaryTree',
+ isa => 'BinaryTree',
predicate => 'has_parent',
weak_ref => 1,
);
-
+
has 'left' => (
- is => 'rw',
- isa => 'BinaryTree',
- predicate => 'has_left',
+ is => 'rw',
+ isa => 'BinaryTree',
+ predicate => 'has_left',
lazy => 1,
- default => sub { BinaryTree->new(parent => $_[0]) },
+ default => sub { BinaryTree->new( parent => $_[0] ) },
);
-
+
has 'right' => (
- is => 'rw',
- isa => 'BinaryTree',
- predicate => 'has_right',
- lazy => 1,
- default => sub { BinaryTree->new(parent => $_[0]) },
+ is => 'rw',
+ isa => 'BinaryTree',
+ predicate => 'has_right',
+ lazy => 1,
+ default => sub { BinaryTree->new( parent => $_[0] ) },
);
-
+
before 'right', 'left' => sub {
- my ($self, $tree) = @_;
- $tree->parent($self) if defined $tree;
+ my ( $self, $tree ) = @_;
+ $tree->parent($self) if defined $tree;
};
=head1 DESCRIPTION
@@ -55,7 +55,7 @@
Now, let's start with the code. Our first attribute is the C<node>
slot, defined as such:
- has 'node' => (is => 'rw', isa => 'Any');
+ has 'node' => ( is => 'rw', isa => 'Any' );
If you recall from the previous recipes, this slot will have a read/write
accessor generated for it, and has a type constraint on it. The new item here is
@@ -72,7 +72,7 @@
has 'parent' => (
is => 'rw',
- isa => 'BinaryTree',
+ isa => 'BinaryTree',
predicate => 'has_parent',
weak_ref => 1,
);
@@ -100,11 +100,11 @@
save for different names, so I will just describe one here:
has 'left' => (
- is => 'rw',
- isa => 'BinaryTree',
- predicate => 'has_left',
+ is => 'rw',
+ isa => 'BinaryTree',
+ predicate => 'has_left',
lazy => 1,
- default => sub { BinaryTree->new(parent => $_[0]) },
+ default => sub { BinaryTree->new( parent => $_[0] ) },
);
You already know what the C<is>, C<isa> and C<predicate> options do, but now we
@@ -122,11 +122,11 @@
(ARRAY ref, HASH ref, object instance, etc) you would need to
wrap it in a CODE reference, so this:
- has 'foo' => (is => 'rw', default => []);
+ has 'foo' => ( is => 'rw', default => [] );
is actually illegal in Moose. Instead, what you really want is this:
- has 'foo' => (is => 'rw', default => sub { [] });
+ has 'foo' => ( is => 'rw', default => sub { [] } );
This ensures that each instance of this class will get its own ARRAY ref in the
C<foo> slot.
@@ -136,7 +136,7 @@
where the slot will be stored. This can come in quite handy at times, as
illustrated above, with this code:
- default => sub { BinaryTree->new(parent => $_[0]) },
+ default => sub { BinaryTree->new( parent => $_[0] ) },
The default value being generated is a new C<BinaryTree> instance for the
C<left> (or C<right>) slot. Here we set up the correct relationship by passing
@@ -173,10 +173,10 @@
that would require us to implement all those features we got automatically (type
constraints, lazy initialization, and so on). Instead, we use method modifiers
again:
-
+
before 'right', 'left' => sub {
- my ($self, $tree) = @_;
- $tree->parent($self) if defined $tree;
+ my ( $self, $tree ) = @_;
+ $tree->parent($self) if defined $tree;
};
This is a C<before> modifier, just like we saw in the second recipe, but with
Modified: Moose/trunk/lib/Moose/Cookbook/Basics/Recipe5.pod
===================================================================
--- Moose/trunk/lib/Moose/Cookbook/Basics/Recipe5.pod 2009-01-06 05:24:24 UTC (rev 7233)
+++ Moose/trunk/lib/Moose/Cookbook/Basics/Recipe5.pod 2009-01-06 05:32:40 UTC (rev 7234)
@@ -10,61 +10,61 @@
package Request;
use Moose;
use Moose::Util::TypeConstraints;
-
+
use HTTP::Headers ();
use Params::Coerce ();
use URI ();
-
+
subtype 'Header'
=> as 'Object'
=> where { $_->isa('HTTP::Headers') };
-
+
coerce 'Header'
=> from 'ArrayRef'
- => via { HTTP::Headers->new( @{ $_ } ) }
+ => via { HTTP::Headers->new( @{$_} ) }
=> from 'HashRef'
- => via { HTTP::Headers->new( %{ $_ } ) };
-
+ => via { HTTP::Headers->new( %{$_} ) };
+
subtype 'Uri'
=> as 'Object'
=> where { $_->isa('URI') };
-
+
coerce 'Uri'
=> from 'Object'
- => via { $_->isa('URI')
- ? $_
- : Params::Coerce::coerce( 'URI', $_ ) }
+ => via { $_->isa('URI')
+ ? $_
+ : Params::Coerce::coerce( 'URI', $_ ); }
=> from 'Str'
=> via { URI->new( $_, 'http' ) };
-
+
subtype 'Protocol'
- => as Str
+ => as 'Str'
=> where { /^HTTP\/[0-9]\.[0-9]$/ };
-
- has 'base' => (is => 'rw', isa => 'Uri', coerce => 1);
- has 'uri' => (is => 'rw', isa => 'Uri', coerce => 1);
- has 'method' => (is => 'rw', isa => 'Str');
- has 'protocol' => (is => 'rw', isa => 'Protocol');
+
+ has 'base' => ( is => 'rw', isa => 'Uri', coerce => 1 );
+ has 'uri' => ( is => 'rw', isa => 'Uri', coerce => 1 );
+ has 'method' => ( is => 'rw', isa => 'Str' );
+ has 'protocol' => ( is => 'rw', isa => 'Protocol' );
has 'headers' => (
is => 'rw',
isa => 'Header',
coerce => 1,
- default => sub { HTTP::Headers->new }
+ default => sub { HTTP::Headers->new }
);
=head1 DESCRIPTION
-This recipe introduces the idea of type coercions, and the C<coerce>
-keyword. Coercions can be attached to existing type constraints,
-and can be used to transform input of one type into input of another
-type. This can be an extremely powerful tool if used correctly, which
-is why it is off by default. If you want your accessor to attempt
-a coercion, you must specifically ask for it with the B<coerce> option.
+This recipe introduces the idea of type coercions, and the C<coerce>
+keyword. Coercions can be attached to existing type constraints, and
+can be used to transform input of one type into input of another
+type. This can be an extremely powerful tool if used correctly, which
+is why it is off by default. If you want your accessor to attempt a
+coercion, you must specifically ask for it with the B<coerce> option.
-Now, onto the coercions.
+Now, onto the coercions.
-First we need to create a subtype to attach our coercion to. Here we
-create a basic I<Header> subtype, which matches any instance of the
+First we need to create a subtype to attach our coercion to. Here we
+create a basic I<Header> subtype, which matches any instance of the
class B<HTTP::Headers>:
subtype 'Header'
@@ -74,60 +74,60 @@
The simplest thing from here would be create an accessor declaration
like this:
- has 'headers' => (
+ has 'headers' => (
is => 'rw',
isa => 'Header',
- default => sub { HTTP::Headers->new }
+ default => sub { HTTP::Headers->new }
);
-We would then have a self-validating accessor whose default value is
-an empty instance of B<HTTP::Headers>. This is nice, but it is not
+We would then have a self-validating accessor whose default value is
+an empty instance of B<HTTP::Headers>. This is nice, but it is not
ideal.
The constructor for B<HTTP::Headers> accepts a list of key-value pairs
-representing the HTTP header fields. In Perl, such a list could
-easily be stored in an ARRAY or HASH reference. We would like our
-class's interface to be able to accept this list of key-value pairs
-in place of the B<HTTP::Headers> instance, and just DWIM. This is where
+representing the HTTP header fields. In Perl, such a list could easily
+be stored in an ARRAY or HASH reference. We would like our class's
+interface to be able to accept this list of key-value pairs in place
+of the B<HTTP::Headers> instance, and just DWIM. This is where
coercion can help. First, let's declare our coercion:
coerce 'Header'
=> from 'ArrayRef'
- => via { HTTP::Headers->new( @{ $_ } ) }
+ => via { HTTP::Headers->new( @{$_} ) }
=> from 'HashRef'
- => via { HTTP::Headers->new( %{ $_ } ) };
+ => via { HTTP::Headers->new( %{$_} ) };
We first tell it that we are attaching the coercion to the 'Header'
-subtype. We then give it a set of C<from> clauses which map other
-subtypes to coercion routines (through the C<via> keyword). Fairly
-simple really; however, this alone does nothing. We have to tell
-our attribute declaration to actually use the coercion, like so:
+subtype. We then give it a set of C<from> clauses which map other
+subtypes to coercion routines (through the C<via> keyword). Fairly
+simple really; however, this alone does nothing. We have to tell our
+attribute declaration to actually use the coercion, like so:
- has 'headers' => (
+ has 'headers' => (
is => 'rw',
isa => 'Header',
coerce => 1,
- default => sub { HTTP::Headers->new }
+ default => sub { HTTP::Headers->new }
);
This will coerce any B<ArrayRef> or B<HashRef> which is passed into
the C<headers> accessor into an instance of B<HTTP::Headers>. So the
the following lines of code are all equivalent:
- $foo->headers(HTTP::Headers->new(bar => 1, baz => 2));
- $foo->headers([ 'bar', 1, 'baz', 2 ]);
- $foo->headers({ bar => 1, baz => 2 });
+ $foo->headers( HTTP::Headers->new( bar => 1, baz => 2 ) );
+ $foo->headers( [ 'bar', 1, 'baz', 2 ] );
+ $foo->headers( { bar => 1, baz => 2 } );
-As you can see, careful use of coercions can produce a very open
-interface for your class, while still retaining the "safety" of
-your type constraint checks.
+As you can see, careful use of coercions can produce a very open
+interface for your class, while still retaining the "safety" of your
+type constraint checks.
-Our next coercion takes advantage of the power of CPAN to handle
-the details of our coercion. In this particular case it uses the
+Our next coercion takes advantage of the power of CPAN to handle the
+details of our coercion. In this particular case it uses the
L<Params::Coerce> module, which fits in rather nicely with L<Moose>.
-Again, we create a simple subtype to represent instances of the
-B<URI> class:
+Again, we create a simple subtype to represent instances of the B<URI>
+class:
subtype 'Uri'
=> as 'Object'
@@ -137,50 +137,50 @@
coerce 'Uri'
=> from 'Object'
- => via { $_->isa('URI')
- ? $_
- : Params::Coerce::coerce( 'URI', $_ ) }
+ => via { $_->isa('URI')
+ ? $_
+ : Params::Coerce::coerce( 'URI', $_ ); }
=> from 'Str'
=> via { URI->new( $_, 'http' ) };
-The first C<from> clause we introduce is for the 'Object' subtype. An 'Object'
-is simply any C<bless>ed value. This means that if the coercion encounters
-another object, it should use this clause. Now we look at the C<via> block.
-First it checks to see if the object is a B<URI> instance. Since the coercion
-process occurs prior to any type constraint checking, it is entirely possible
-for this to happen, and if it does happen, we simply want to pass the instance
-on through. However, if it is not an instance of B<URI>, then we need to coerce
-it. This is where L<Params::Coerce> can do its magic, and we can just use its
-return value. Simple really, and much less work since we used a module from CPAN
-:)
+The first C<from> clause we introduce is for the 'Object' subtype. An
+'Object' is simply any C<bless>ed value. This means that if the
+coercion encounters another object, it should use this clause. Now we
+look at the C<via> block. First it checks to see if the object is a
+B<URI> instance. Since the coercion process occurs prior to any type
+constraint checking, it is entirely possible for this to happen, and
+if it does happen, we simply want to pass the instance on
+through. However, if it is not an instance of B<URI>, then we need to
+coerce it. This is where L<Params::Coerce> can do its magic, and we
+can just use its return value. Simple really, and much less work since
+we used a module from CPAN :)
-The second C<from> clause is attached to the 'Str' subtype, and
-illustrates how coercions can also be used to handle certain
-'default' behaviors. In this coercion, we simple take any string
-and pass it to the B<URI> constructor along with the default
-'http' scheme type.
+The second C<from> clause is attached to the 'Str' subtype, and
+illustrates how coercions can also be used to handle certain 'default'
+behaviors. In this coercion, we simple take any string and pass it to
+the B<URI> constructor along with the default 'http' scheme type.
-And of course, our coercions do nothing unless they are told to,
-like so:
+And of course, our coercions do nothing unless they are told to, like
+so:
- has 'base' => (is => 'rw', isa => 'Uri', coerce => 1);
- has 'uri' => (is => 'rw', isa => 'Uri', coerce => 1);
+ has 'base' => ( is => 'rw', isa => 'Uri', coerce => 1 );
+ has 'uri' => ( is => 'rw', isa => 'Uri', coerce => 1 );
-As you can see, re-using the coercion allows us to enforce a
+As you can see, re-using the coercion allows us to enforce a
consistent and very flexible API across multiple accessors.
=head1 CONCLUSION
-This recipe illustrated the power of coercions to build a more
-flexible and open API for your accessors, while still retaining
-all the safety that comes from using Moose's type constraints.
-Using coercions it becomes simple to manage (from a single
-location) a consistent API not only across multiple accessors,
-but across multiple classes as well.
+This recipe illustrated the power of coercions to build a more
+flexible and open API for your accessors, while still retaining all
+the safety that comes from using Moose's type constraints. Using
+coercions it becomes simple to manage (from a single location) a
+consistent API not only across multiple accessors, but across multiple
+classes as well.
-In the next recipe, we will introduce roles, a concept originally
-borrowed from Smalltalk, which made its way into Perl 6, and
-now into Moose.
+In the next recipe, we will introduce roles, a concept originally
+borrowed from Smalltalk, which made its way into Perl 6, and now into
+Moose.
=head1 AUTHOR
Modified: Moose/trunk/lib/Moose/Cookbook/Basics/Recipe7.pod
===================================================================
--- Moose/trunk/lib/Moose/Cookbook/Basics/Recipe7.pod 2009-01-06 05:24:24 UTC (rev 7233)
+++ Moose/trunk/lib/Moose/Cookbook/Basics/Recipe7.pod 2009-01-06 05:32:40 UTC (rev 7234)
@@ -10,8 +10,8 @@
package Point;
use Moose;
- has 'x' => (isa => 'Int', is => 'ro');
- has 'y' => (isa => 'Int', is => 'rw');
+ has 'x' => ( isa => 'Int', is => 'ro' );
+ has 'y' => ( isa => 'Int', is => 'rw' );
__PACKAGE__->meta->make_immutable;
More information about the Moose-commits
mailing list