matteo/lms-plugins
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases 1 Wiki Activity

Add Moose package
All checks were successful
release / release-plugins (push) Successful in 28s
Details

Browse Source
This commit is contained in:
mschuepbach
2024-04-24 13:33:38 +02:00
parent 24101a5c1a
commit d95734d3d0
413 changed files with 47294 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

384
CPAN/Moose/Cookbook/Basics/BankAccount_MethodModifiersAndSubclassing.pod Normal file
View File

@@ -0,0 +1,384 @@
# PODNAME: Moose::Cookbook::Basics::BankAccount_MethodModifiersAndSubclassing
# ABSTRACT: Demonstrates the use of method modifiers in a subclass
__END__
=pod
=encoding UTF-8
=head1 NAME
Moose::Cookbook::Basics::BankAccount_MethodModifiersAndSubclassing - Demonstrates the use of method modifiers in a subclass
=head1 VERSION
version 2.2207
=head1 SYNOPSIS
package BankAccount;
use Moose;
has 'balance' => ( isa => 'Int', is => 'rw', default => 0 );
sub deposit {
my ( $self, $amount ) = @_;
$self->balance( $self->balance + $amount );
}
sub withdraw {
my ( $self, $amount ) = @_;
my $current_balance = $self->balance();
( $current_balance >= $amount )
|| confess "Account overdrawn";
$self->balance( $current_balance - $amount );
}
package CheckingAccount;
use Moose;
extends 'BankAccount';
has 'overdraft_account' => ( isa => 'BankAccount', is => 'rw' );
before 'withdraw' => sub {
my ( $self, $amount ) = @_;
my $overdraft_amount = $amount - $self->balance();
if ( $self->overdraft_account && $overdraft_amount > 0 ) {
$self->overdraft_account->withdraw($overdraft_amount);
$self->deposit($overdraft_amount);
}
};
=head1 DESCRIPTION
The first recipe demonstrated how to build very basic Moose classes,
focusing on creating and manipulating attributes. The objects in that
recipe were very data-oriented, and did not have much in the way of
behavior (i.e. methods). In this recipe, we expand upon the concepts
from the first recipe to include some real behavior. In particular, we
show how you can use a method modifier to implement new behavior for a
method.
The classes in the SYNOPSIS show two kinds of bank account. A simple
bank account has one attribute, the balance, and two behaviors,
depositing and withdrawing money.
We then extend the basic bank account in the CheckingAccount
class. This class adds another attribute, an overdraft account. It
also adds overdraft protection to the withdraw method. If you try to
withdraw more than you have, the checking account attempts to
reconcile the difference by withdrawing money from the overdraft
account. (1)
The first class, B<BankAccount>, introduces a new attribute feature, a
default value:
has 'balance' => ( isa => 'Int', is => 'rw', default => 0 );
This says that a B<BankAccount> has a C<balance> attribute, which has
an C<Int> type constraint, a read/write accessor, and a default value
of C<0>. This means that every instance of B<BankAccount> that is
created will have its C<balance> slot initialized to C<0>, unless some
other value is provided to the constructor.
The C<deposit> and C<withdraw> methods should be fairly
self-explanatory, as they are just plain old Perl 5 OO. (2)
As you know from the first recipe, the keyword C<extends> sets a
class's superclass. Here we see that B<CheckingAccount> C<extends>
B<BankAccount>. The next line introduces yet another new attribute
feature, class-based type constraints:
has 'overdraft_account' => ( isa => 'BankAccount', is => 'rw' );
Up until now, we have only seen the C<Int> type constraint, which (as
we saw in the first recipe) is a builtin type constraint. The
C<BankAccount> type constraint is new, and was actually defined the
moment we created the B<BankAccount> class itself. In fact, Moose
creates a corresponding type constraint for every class in your
program (3).
This means that in the first recipe, constraints for both C<Point> and
C<Point3D> were created. In this recipe, both C<BankAccount> and
C<CheckingAccount> type constraints are created automatically. Moose
does this as a convenience so that your classes and type constraint
can be kept in sync with one another. In short, Moose makes sure that
it will just DWIM (4).
In B<CheckingAccount>, we see another method modifier, the C<before>
modifier.
before 'withdraw' => sub {
my ( $self, $amount ) = @_;
my $overdraft_amount = $amount - $self->balance();
if ( $self->overdraft_account && $overdraft_amount > 0 ) {
$self->overdraft_account->withdraw($overdraft_amount);
$self->deposit($overdraft_amount);
}
};
Just as with the C<after> modifier from the first recipe, Moose will
handle calling the superclass method (in this case C<<
BankAccount->withdraw >>).
The C<before> modifier will (obviously) run I<before> the code from
the superclass is run. Here, C<before> modifier implements overdraft
protection by first checking if there are available funds in the
checking account. If not (and if there is an overdraft account
available), it transfers the amount needed into the checking
account (5).
As with the method modifier in the first recipe, we could use
C<SUPER::> to get the same effect:
sub withdraw {
my ( $self, $amount ) = @_;
my $overdraft_amount = $amount - $self->balance();
if ( $self->overdraft_account && $overdraft_amount > 0 ) {
$self->overdraft_account->withdraw($overdraft_amount);
$self->deposit($overdraft_amount);
}
$self->SUPER::withdraw($amount);
}
The benefit of taking the method modifier approach is we do not need
to remember to call C<SUPER::withdraw> and pass it the C<$amount>
argument when writing C<< CheckingAccount->withdraw >>.
This is actually more than just a convenience for forgetful
programmers. Using method modifiers helps isolate subclasses from
changes in the superclasses. For instance, if B<<
BankAccount->withdraw >> were to add an additional argument of some
kind, the version of B<< CheckingAccount->withdraw >> which uses
C<SUPER::withdraw> would not pass that extra argument correctly,
whereas the method modifier version would automatically pass along all
arguments correctly.
Just as with the first recipe, object instantiation uses the C<new>
method, which accepts named parameters.
my $savings_account = BankAccount->new( balance => 250 );
my $checking_account = CheckingAccount->new(
balance => 100,
overdraft_account => $savings_account,
);
And as with the first recipe, a more in-depth example can be found in
the F<t/recipes/basics_bankaccount_methodmodifiersandsubclassing.t> test file.
=head1 CONCLUSION
This recipe expanded on the basic concepts from the first recipe with
a more "real world" use case.
=head1 FOOTNOTES
=over 4
=item (1)
If you're paying close attention, you might realize that there's a
circular loop waiting to happen here. A smarter example would have to
make sure that we don't accidentally create a loop between the
checking account and its overdraft account.
=item (2)
Note that for simple methods like these, which just manipulate some
single piece of data, it is often not necessary to write them at all.
For instance, C<deposit> could be implemented via the C<inc> native
delegation for counters - see
L<Moose::Meta::Attribute::Native::Trait::Counter> for more specifics,
and L<Moose::Meta::Attribute::Native> for a broader overview.
=item (3)
In reality, this creation is sensitive to the order in which modules
are loaded. In more complicated cases, you may find that you need to
explicitly declare a class type before the corresponding class is
loaded.
=item (4)
Moose does not attempt to encode a class's is-a relationships within
the type constraint hierarchy. Instead, Moose just considers the class
type constraint to be a subtype of C<Object>, and specializes the
constraint check to allow for subclasses. This means that an instance
of B<CheckingAccount> will pass a C<BankAccount> type constraint
successfully. For more details, please refer to the
L<Moose::Util::TypeConstraints> documentation.
=item (5)
If the overdraft account does not have the amount needed, it will
throw an error. Of course, the overdraft account could also have
overdraft protection. See note 1.
=back
=head1 ACKNOWLEDGMENT
The BankAccount example in this recipe is directly taken from the
examples in this chapter of "Practical Common Lisp":
L<http://www.gigamonkeys.com/book/object-reorientation-generic-functions.html>
=begin testing
my $savings_account;
{
$savings_account = BankAccount->new( balance => 250 );
isa_ok( $savings_account, 'BankAccount' );
is( $savings_account->balance, 250, '... got the right savings balance' );
is(
exception {
$savings_account->withdraw(50);
},
undef,
'... withdrew from savings successfully'
);
is( $savings_account->balance, 200,
'... got the right savings balance after withdrawal' );
$savings_account->deposit(150);
is( $savings_account->balance, 350,
'... got the right savings balance after deposit' );
}
{
my $checking_account = CheckingAccount->new(
balance => 100,
overdraft_account => $savings_account
);
isa_ok( $checking_account, 'CheckingAccount' );
isa_ok( $checking_account, 'BankAccount' );
is( $checking_account->overdraft_account, $savings_account,
'... got the right overdraft account' );
is( $checking_account->balance, 100,
'... got the right checkings balance' );
is(
exception {
$checking_account->withdraw(50);
},
undef,
'... withdrew from checking successfully'
);
is( $checking_account->balance, 50,
'... got the right checkings balance after withdrawal' );
is( $savings_account->balance, 350,
'... got the right savings balance after checking withdrawal (no overdraft)'
);
is(
exception {
$checking_account->withdraw(200);
},
undef,
'... withdrew from checking successfully'
);
is( $checking_account->balance, 0,
'... got the right checkings balance after withdrawal' );
is( $savings_account->balance, 200,
'... got the right savings balance after overdraft withdrawal' );
}
{
my $checking_account = CheckingAccount->new(
balance => 100
# no overdraft account
);
isa_ok( $checking_account, 'CheckingAccount' );
isa_ok( $checking_account, 'BankAccount' );
is( $checking_account->overdraft_account, undef,
'... no overdraft account' );
is( $checking_account->balance, 100,
'... got the right checkings balance' );
is(
exception {
$checking_account->withdraw(50);
},
undef,
'... withdrew from checking successfully'
);
is( $checking_account->balance, 50,
'... got the right checkings balance after withdrawal' );
isnt(
exception {
$checking_account->withdraw(200);
},
undef,
'... withdrawal failed due to attempted overdraft'
);
is( $checking_account->balance, 50,
'... got the right checkings balance after withdrawal failure' );
}
=end testing
=head1 AUTHORS
=over 4
=item *
Stevan Little <stevan@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

397
CPAN/Moose/Cookbook/Basics/BinaryTree_AttributeFeatures.pod Normal file
View File

@@ -0,0 +1,397 @@
# PODNAME: Moose::Cookbook::Basics::BinaryTree_AttributeFeatures
# ABSTRACT: Demonstrates various attribute features including lazy, predicates, weak refs, and more
__END__
=pod
=encoding UTF-8
=head1 NAME
Moose::Cookbook::Basics::BinaryTree_AttributeFeatures - Demonstrates various attribute features including lazy, predicates, weak refs, and more
=head1 VERSION
version 2.2207
=head1 SYNOPSIS
package BinaryTree;
use Moose;
has 'node' => ( is => 'rw', isa => 'Any' );
has 'parent' => (
is => 'rw',
isa => 'BinaryTree',
predicate => 'has_parent',
weak_ref => 1,
);
has 'left' => (
is => 'rw',
isa => 'BinaryTree',
predicate => 'has_left',
lazy => 1,
default => sub { BinaryTree->new( parent => $_[0] ) },
trigger => \&_set_parent_for_child
);
has 'right' => (
is => 'rw',
isa => 'BinaryTree',
predicate => 'has_right',
lazy => 1,
default => sub { BinaryTree->new( parent => $_[0] ) },
trigger => \&_set_parent_for_child
);
sub _set_parent_for_child {
my ( $self, $child ) = @_;
confess "You cannot insert a tree which already has a parent"
if $child->has_parent;
$child->parent($self);
}
=head1 DESCRIPTION
This recipe shows how various advanced attribute features can be used
to create complex and powerful behaviors. In particular, we introduce
a number of new attribute options, including C<predicate>, C<lazy>,
and C<trigger>.
The example class is a classic binary tree. Each node in the tree is
itself an instance of C<BinaryTree>. It has a C<node>, which holds
some arbitrary value. It has C<right> and C<left> attributes, which
refer to its child trees, and a C<parent>.
Let's take a look at the C<node> attribute:
has 'node' => ( is => 'rw', isa => 'Any' );
Moose generates a read-write accessor for this attribute. The type
constraint is C<Any>, which literally means it can contain anything.
We could have left out the C<isa> option, but in this case, we are
including it for the benefit of other programmers, not the computer.
Next, let's move on to the C<parent> attribute:
has 'parent' => (
is => 'rw',
isa => 'BinaryTree',
predicate => 'has_parent',
weak_ref => 1,
);
Again, we have a read-write accessor. This time, the C<isa> option
says that this attribute must always be an instance of
C<BinaryTree>. In the second recipe, we saw that every time we create
a Moose-based class, we also get a corresponding class type
constraint.
The C<predicate> option is new. It creates a method which can be used
to check whether or not a given attribute has been initialized. In
this case, the method is named C<has_parent>.
This brings us to our last attribute option, C<weak_ref>. Since
C<parent> is a circular reference (the tree in C<parent> should
already have a reference to this one, in its C<left> or C<right>
attribute), we want to make sure that we weaken the reference to avoid
memory leaks. If C<weak_ref> is true, it alters the accessor function
so that the reference is weakened when it is set.
Finally, we have the C<left> and C<right> attributes. They are
essentially identical except for their names, so we'll just look at
C<left>:
has 'left' => (
is => 'rw',
isa => 'BinaryTree',
predicate => 'has_left',
lazy => 1,
default => sub { BinaryTree->new( parent => $_[0] ) },
trigger => \&_set_parent_for_child
);
There are three new options here, C<lazy>, C<default>, and
C<trigger>. The C<lazy> and C<default> options are linked. In fact,
you cannot have a C<lazy> attribute unless it has a C<default>
(or a C<builder>, but we'll cover that later). If you try to make an
attribute lazy without a default, class creation will fail with an
exception. (2)
In the second recipe the B<BankAccount>'s C<balance> attribute had a
default value of C<0>. Given a non-reference, Perl copies the
I<value>. However, given a reference, it does not do a deep clone,
instead simply copying the reference. If you just specified a simple
reference for a default, Perl would create it once and it would be
shared by all objects with that attribute.
As a workaround, we use an anonymous subroutine to generate a new
reference every time the default is called.
has 'foo' => ( is => 'rw', default => sub { [] } );
In fact, using a non-subroutine reference as a default is illegal in Moose.
# will fail
has 'foo' => ( is => 'rw', default => [] );
This will blow up, so don't do it.
You'll notice that we use C<$_[0]> in our default sub. When the
default subroutine is executed, it is called as a method on the
object.
In our case, we're making a new C<BinaryTree> object in our default,
with the current tree as the parent.
Normally, when an object is instantiated, any defaults are evaluated
immediately. With our C<BinaryTree> class, this would be a big
problem! We'd create the first object, which would immediately try to
populate its C<left> and C<right> attributes, which would create a new
C<BinaryTree>, which would populate I<its> C<left> and C<right>
slots. Kaboom!
By making our C<left> and C<right> attributes C<lazy>, we avoid this
problem. If the attribute has a value when it is read, the default is
never executed at all.
We still have one last bit of behavior to add. The autogenerated
C<right> and C<left> accessors are not quite correct. When one of
these is set, we want to make sure that we update the parent of the
C<left> or C<right> attribute's tree.
We could write our own accessors, but then why use Moose at all?
Instead, we use a C<trigger>. A C<trigger> accepts a subroutine
reference, which will be called as a method whenever the attribute is
set. This can happen both during object construction or later by
passing a new object to the attribute's accessor method. However, it
is not called when a value is provided by a C<default> or C<builder>.
sub _set_parent_for_child {
my ( $self, $child ) = @_;
confess "You cannot insert a tree which already has a parent"
if $child->has_parent;
$child->parent($self);
}
This trigger does two things. First, it ensures that the new child
node does not already have a parent. This is done for the sake of
simplifying the example. If we wanted to be more clever, we would
remove the child from its old parent tree and add it to the new one.
If the child has no parent, we will add it to the current tree, and we
ensure that is has the correct value for its C<parent> attribute.
As with all the other recipes, B<BinaryTree> can be used just like any
other Perl 5 class. A more detailed example of its usage can be found
in F<t/recipes/basics_binarytree_attributefeatures.t>.
=head1 CONCLUSION
This recipe introduced several of Moose's advanced features. We hope
that this inspires you to think of other ways these features can be
used to simplify your code.
=head1 FOOTNOTES
=over 4
=item (1)
Weak references are tricky things, and should be used sparingly and
appropriately (such as in the case of circular refs). If you are not
careful, attribute values could disappear "mysteriously" because
Perl's reference counting garbage collector has gone and removed the
item you are weak-referencing.
In short, don't use them unless you know what you are doing :)
=item (2)
You I<can> use the C<default> option without the C<lazy> option if you
like, as we showed in the second recipe.
Also, you can use C<builder> instead of C<default>. See
L<Moose::Cookbook::Basics::BinaryTree_BuilderAndLazyBuild> for details.
=back
=begin testing
use Scalar::Util 'isweak';
my $root = BinaryTree->new(node => 'root');
isa_ok($root, 'BinaryTree');
is($root->node, 'root', '... got the right node value');
ok(!$root->has_left, '... no left node yet');
ok(!$root->has_right, '... no right node yet');
ok(!$root->has_parent, '... no parent for root node');
# make a left node
my $left = $root->left;
isa_ok($left, 'BinaryTree');
is($root->left, $left, '... got the same node (and it is $left)');
ok($root->has_left, '... we have a left node now');
ok($left->has_parent, '... lefts has a parent');
is($left->parent, $root, '... lefts parent is the root');
ok(isweak($left->{parent}), '... parent is a weakened ref');
ok(!$left->has_left, '... $left no left node yet');
ok(!$left->has_right, '... $left no right node yet');
is($left->node, undef, '... left has got no node value');
is(
exception {
$left->node('left');
},
undef,
'... assign to lefts node'
);
is($left->node, 'left', '... left now has a node value');
# make a right node
ok(!$root->has_right, '... still no right node yet');
is($root->right->node, undef, '... right has got no node value');
ok($root->has_right, '... now we have a right node');
my $right = $root->right;
isa_ok($right, 'BinaryTree');
is(
exception {
$right->node('right');
},
undef,
'... assign to rights node'
);
is($right->node, 'right', '... left now has a node value');
is($root->right, $right, '... got the same node (and it is $right)');
ok($root->has_right, '... we have a right node now');
ok($right->has_parent, '... rights has a parent');
is($right->parent, $root, '... rights parent is the root');
ok(isweak($right->{parent}), '... parent is a weakened ref');
# make a left node of the left node
my $left_left = $left->left;
isa_ok($left_left, 'BinaryTree');
ok($left_left->has_parent, '... left does have a parent');
is($left_left->parent, $left, '... got a parent node (and it is $left)');
ok($left->has_left, '... we have a left node now');
is($left->left, $left_left, '... got a left node (and it is $left_left)');
ok(isweak($left_left->{parent}), '... parent is a weakened ref');
# make a right node of the left node
my $left_right = BinaryTree->new;
isa_ok($left_right, 'BinaryTree');
is(
exception {
$left->right($left_right);
},
undef,
'... assign to rights node'
);
ok($left_right->has_parent, '... left does have a parent');
is($left_right->parent, $left, '... got a parent node (and it is $left)');
ok($left->has_right, '... we have a left node now');
is($left->right, $left_right, '... got a left node (and it is $left_left)');
ok(isweak($left_right->{parent}), '... parent is a weakened ref');
# and check the error
isnt(
exception {
$left_right->right($left_left);
},
undef,
'... cannot assign a node which already has a parent'
);
=end testing
=head1 AUTHORS
=over 4
=item *
Stevan Little <stevan@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

176
CPAN/Moose/Cookbook/Basics/BinaryTree_BuilderAndLazyBuild.pod Normal file
View File

@@ -0,0 +1,176 @@
# PODNAME: Moose::Cookbook::Basics::BinaryTree_BuilderAndLazyBuild
# ABSTRACT: Builder methods and lazy_build
__END__
=pod
=encoding UTF-8
=head1 NAME
Moose::Cookbook::Basics::BinaryTree_BuilderAndLazyBuild - Builder methods and lazy_build
=head1 VERSION
version 2.2207
=head1 SYNOPSIS
package BinaryTree;
use Moose;
has 'node' => (is => 'rw', isa => 'Any');
has 'parent' => (
is => 'rw',
isa => 'BinaryTree',
predicate => 'has_parent',
weak_ref => 1,
);
has 'left' => (
is => 'rw',
isa => 'BinaryTree',
predicate => 'has_left',
lazy => 1,
builder => '_build_child_tree',
);
has 'right' => (
is => 'rw',
isa => 'BinaryTree',
predicate => 'has_right',
lazy => 1,
builder => '_build_child_tree',
);
before 'right', 'left' => sub {
my ($self, $tree) = @_;
$tree->parent($self) if defined $tree;
};
sub _build_child_tree {
my $self = shift;
return BinaryTree->new( parent => $self );
}
=head1 DESCRIPTION
If you've already read
L<Moose::Cookbook::Basics::BinaryTree_AttributeFeatures>, then this example
should look very familiar. In fact, all we've done here is replace the
attribute's C<default> parameter with a C<builder>.
In this particular case, the C<default> and C<builder> options act in
exactly the same way. When the C<left> or C<right> attribute is read,
Moose calls the builder method to initialize the attribute.
Note that Moose calls the builder method I<on the object which has the
attribute>. Here's an example:
my $tree = BinaryTree->new();
my $left = $tree->left();
When C<< $tree->left() >> is called, Moose calls C<<
$tree->_build_child_tree() >> in order to populate the C<left>
attribute. If we had passed C<left> to the original constructor, the
builder would not be called.
There are some differences between C<default> and C<builder>. Notably,
a builder is subclassable, and can be composed from a role. See
L<Moose::Manual::Attributes> for more details.
=head2 The lazy_build shortcut
The C<lazy_build> attribute option can be used as sugar to specify
a whole set of attribute options at once:
has 'animal' => (
is => 'ro',
isa => 'Animal',
lazy_build => 1,
);
This is a shorthand for:
has 'animal' => (
is => 'ro',
isa => 'Animal',
required => 1,
lazy => 1,
builder => '_build_animal',
predicate => 'has_animal',
clearer => 'clear_animal',
);
If your attribute starts with an underscore, Moose is smart and will
do the right thing with the C<predicate> and C<clearer>, making them
both start with an underscore. The C<builder> method I<always> starts
with an underscore.
You can read more about C<lazy_build> in L<Moose::Meta::Attribute>
=head1 CONCLUSION
The C<builder> option is a more OO-friendly version of the C<default>
functionality. It also separates the default-generating code into a
well-defined method. Sprinkling your attribute definitions with
anonymous subroutines can be quite ugly and hard to follow.
=head1 AUTHORS
=over 4
=item *
Stevan Little <stevan@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

615
CPAN/Moose/Cookbook/Basics/Company_Subtypes.pod Normal file
View File

@@ -0,0 +1,615 @@
# PODNAME: Moose::Cookbook::Basics::Company_Subtypes
# ABSTRACT: Demonstrates the use of subtypes and how to model classes related to companies, people, employees, etc.
__END__
=pod
=encoding UTF-8
=head1 NAME
Moose::Cookbook::Basics::Company_Subtypes - Demonstrates the use of subtypes and how to model classes related to companies, people, employees, etc.
=head1 VERSION
version 2.2207
=head1 SYNOPSIS
package Address;
use Moose;
use Moose::Util::TypeConstraints;
use Locale::US;
use Regexp::Common 'zip';
my $STATES = Locale::US->new;
subtype 'USState'
=> as Str
=> where {
( exists $STATES->{code2state}{ uc($_) }
|| exists $STATES->{state2code}{ uc($_) } );
};
subtype 'USZipCode'
=> as Value
=> where {
/^$RE{zip}{US}{-extended => 'allow'}$/;
};
has 'street' => ( is => 'rw', isa => 'Str' );
has 'city' => ( is => 'rw', isa => 'Str' );
has 'state' => ( is => 'rw', isa => 'USState' );
has 'zip_code' => ( is => 'rw', isa => 'USZipCode' );
package Company;
use Moose;
use Moose::Util::TypeConstraints;
has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
has 'address' => ( is => 'rw', isa => 'Address' );
has 'employees' => (
is => 'rw',
isa => 'ArrayRef[Employee]',
default => sub { [] },
);
sub BUILD {
my ( $self, $params ) = @_;
foreach my $employee ( @{ $self->employees } ) {
$employee->employer($self);
}
}
after 'employees' => sub {
my ( $self, $employees ) = @_;
return unless $employees;
foreach my $employee ( @$employees ) {
$employee->employer($self);
}
};
package Person;
use Moose;
has 'first_name' => ( is => 'rw', isa => 'Str', required => 1 );
has 'last_name' => ( is => 'rw', isa => 'Str', required => 1 );
has 'middle_initial' => (
is => 'rw', isa => 'Str',
predicate => 'has_middle_initial'
);
has 'address' => ( is => 'rw', isa => 'Address' );
sub full_name {
my $self = shift;
return $self->first_name
. (
$self->has_middle_initial
? ' ' . $self->middle_initial . '. '
: ' '
) . $self->last_name;
}
package Employee;
use Moose;
extends 'Person';
has 'title' => ( is => 'rw', isa => 'Str', required => 1 );
has 'employer' => ( is => 'rw', isa => 'Company', weak_ref => 1 );
override 'full_name' => sub {
my $self = shift;
super() . ', ' . $self->title;
};
=head1 DESCRIPTION
This recipe introduces the C<subtype> sugar function from
L<Moose::Util::TypeConstraints>. The C<subtype> function lets you
declaratively create type constraints without building an entire
class.
In the recipe we also make use of L<Locale::US> and L<Regexp::Common>
to build constraints, showing how constraints can make use of existing
CPAN tools for data validation.
Finally, we introduce the C<required> attribute option.
In the C<Address> class we define two subtypes. The first uses the
L<Locale::US> module to check the validity of a state. It accepts
either a state abbreviation or full name.
A state will be passed in as a string, so we make our C<USState> type
a subtype of Moose's builtin C<Str> type. This is done using the C<as>
sugar. The actual constraint is defined using C<where>. This function
accepts a single subroutine reference. That subroutine will be called
with the value to be checked in C<$_> (1). It is expected to return a
true or false value indicating whether the value is valid for the
type.
We can now use the C<USState> type just like Moose's builtin types:
has 'state' => ( is => 'rw', isa => 'USState' );
When the C<state> attribute is set, the value is checked against the
C<USState> constraint. If the value is not valid, an exception will be
thrown.
The next C<subtype>, C<USZipCode>, uses
L<Regexp::Common>. L<Regexp::Common> includes a regex for validating
US zip codes. We use this constraint for the C<zip_code> attribute.
subtype 'USZipCode'
=> as Value
=> where {
/^$RE{zip}{US}{-extended => 'allow'}$/;
};
Using a subtype instead of requiring a class for each type greatly
simplifies the code. We don't really need a class for these types, as
they're just strings, but we do want to ensure that they're valid.
The type constraints we created are reusable. Type constraints are
stored by name in a global registry, which means that we can refer to
them in other classes. Because the registry is global, we do recommend
that you use some sort of namespacing in real applications,
like C<MyApp::Type::USState> (just as you would do with class names).
These two subtypes allow us to define a simple C<Address> class.
Then we define our C<Company> class, which has an address. As we saw
in earlier recipes, Moose automatically creates a type constraint for
each our classes, so we can use that for the C<Company> class's
C<address> attribute:
has 'address' => ( is => 'rw', isa => 'Address' );
A company also needs a name:
has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
This introduces a new attribute option, C<required>. If an attribute
is required, then it must be passed to the class's constructor, or an
exception will be thrown. It's important to understand that a
C<required> attribute can still be false or C<undef>, if its type
constraint allows that.
The next attribute, C<employees>, uses a I<parameterized> type
constraint:
has 'employees' => (
is => 'rw',
isa => 'ArrayRef[Employee]'
default => sub { [] },
);
This constraint says that C<employees> must be an array reference
where each element of the array is an C<Employee> object. It's worth
noting that an I<empty> array reference also satisfies this
constraint, such as the value given as the default here.
Parameterizable type constraints (or "container types"), such as
C<ArrayRef[`a]>, can be made more specific with a type parameter. In
fact, we can arbitrarily nest these types, producing something like
C<HashRef[ArrayRef[Int]]>. However, you can also just use the type by
itself, so C<ArrayRef> is legal. (2)
If you jump down to the definition of the C<Employee> class, you will
see that it has an C<employer> attribute.
When we set the C<employees> for a C<Company> we want to make sure
that each of these employee objects refers back to the right
C<Company> in its C<employer> attribute.
To do that, we need to hook into object construction. Moose lets us do
this by writing a C<BUILD> method in our class. When your class
defines a C<BUILD> method, it will be called by the constructor
immediately after object construction, but before the object is returned
to the caller. Note that all C<BUILD> methods in your class hierarchy
will be called automatically; there is no need to (and you should not)
call the superclass C<BUILD> method.
The C<Company> class uses the C<BUILD> method to ensure that each
employee of a company has the proper C<Company> object in its
C<employer> attribute:
sub BUILD {
my ( $self, $params ) = @_;
foreach my $employee ( @{ $self->employees } ) {
$employee->employer($self);
}
}
The C<BUILD> method is executed after type constraints are checked, so it is
safe to assume that if C<< $self->employees >> has a value, it will be an
array reference, and that the elements of that array reference will be
C<Employee> objects.
We also want to make sure that whenever the C<employees> attribute for
a C<Company> is changed, we also update the C<employer> for each
employee.
To do this we can use an C<after> modifier:
after 'employees' => sub {
my ( $self, $employees ) = @_;
return unless $employees;
foreach my $employee ( @$employees ) {
$employee->employer($self);
}
};
Again, as with the C<BUILD> method, we know that the type constraint check has
already happened, so we know that if C<$employees> is defined it will contain
an array reference of C<Employee> objects.
Note that C<employees> is a read/write accessor, so we must return early if
it's called as a reader.
The B<Person> class does not really demonstrate anything new. It has several
C<required> attributes. It also has a C<predicate> method, which we
first used in L<Moose::Cookbook::Basics::BinaryTree_AttributeFeatures>.
The only new feature in the C<Employee> class is the C<override>
method modifier:
override 'full_name' => sub {
my $self = shift;
super() . ', ' . $self->title;
};
This is just a sugary alternative to Perl's built in C<SUPER::>
feature. However, there is one difference. You cannot pass any
arguments to C<super>. Instead, Moose simply passes the same
parameters that were passed to the method.
A more detailed example of usage can be found in
F<t/recipes/basics_company_subtypes.t>.
=begin testing-SETUP
# we have to do this silliness because Test::Inline already added a plan for us.
BEGIN {
if ("$]" <= '5.010') {
diag 'this test requires Regexp::Common (therefore perl 5.010)';
pass;
exit 0;
}
}
use Test::Needs {
'Locale::US' => '0',
'Regexp::Common' => '0',
};
=end testing-SETUP
=head1 CONCLUSION
This recipe was intentionally longer and more complex. It illustrates
how Moose classes can be used together with type constraints, as well
as the density of information that you can get out of a small amount
of typing when using Moose.
This recipe also introduced the C<subtype> function, the C<required>
attribute, and the C<override> method modifier.
We will revisit type constraints in future recipes, and cover type
coercion as well.
=head1 FOOTNOTES
=over 4
=item (1)
The value being checked is also passed as the first argument to
the C<where> block, so it can be accessed as C<$_[0]>.
=item (2)
Note that C<ArrayRef[]> will not work. Moose will not parse this as a
container type, and instead you will have a new type named
"ArrayRef[]", which doesn't make any sense.
=back
=begin testing
{
package Company;
sub get_employee_count { scalar @{(shift)->employees} }
}
use Scalar::Util 'isweak';
my $ii;
is(
exception {
$ii = Company->new(
{
name => 'Infinity Interactive',
address => Address->new(
street => '565 Plandome Rd., Suite 307',
city => 'Manhasset',
state => 'NY',
zip_code => '11030'
),
employees => [
Employee->new(
first_name => 'Jeremy',
last_name => 'Shao',
title => 'President / Senior Consultant',
address => Address->new(
city => 'Manhasset', state => 'NY'
)
),
Employee->new(
first_name => 'Tommy',
last_name => 'Lee',
title => 'Vice President / Senior Developer',
address =>
Address->new( city => 'New York', state => 'NY' )
),
Employee->new(
first_name => 'Stevan',
middle_initial => 'C',
last_name => 'Little',
title => 'Senior Developer',
address =>
Address->new( city => 'Madison', state => 'CT' )
),
]
}
);
},
undef,
'... created the entire company successfully'
);
isa_ok( $ii, 'Company' );
is( $ii->name, 'Infinity Interactive',
'... got the right name for the company' );
isa_ok( $ii->address, 'Address' );
is( $ii->address->street, '565 Plandome Rd., Suite 307',
'... got the right street address' );
is( $ii->address->city, 'Manhasset', '... got the right city' );
is( $ii->address->state, 'NY', '... got the right state' );
is( $ii->address->zip_code, 11030, '... got the zip code' );
is( $ii->get_employee_count, 3, '... got the right employee count' );
# employee #1
isa_ok( $ii->employees->[0], 'Employee' );
isa_ok( $ii->employees->[0], 'Person' );
is( $ii->employees->[0]->first_name, 'Jeremy',
'... got the right first name' );
is( $ii->employees->[0]->last_name, 'Shao', '... got the right last name' );
ok( !$ii->employees->[0]->has_middle_initial, '... no middle initial' );
is( $ii->employees->[0]->middle_initial, undef,
'... got the right middle initial value' );
is( $ii->employees->[0]->full_name,
'Jeremy Shao, President / Senior Consultant',
'... got the right full name' );
is( $ii->employees->[0]->title, 'President / Senior Consultant',
'... got the right title' );
is( $ii->employees->[0]->employer, $ii, '... got the right company' );
ok( isweak( $ii->employees->[0]->{employer} ),
'... the company is a weak-ref' );
isa_ok( $ii->employees->[0]->address, 'Address' );
is( $ii->employees->[0]->address->city, 'Manhasset',
'... got the right city' );
is( $ii->employees->[0]->address->state, 'NY', '... got the right state' );
# employee #2
isa_ok( $ii->employees->[1], 'Employee' );
isa_ok( $ii->employees->[1], 'Person' );
is( $ii->employees->[1]->first_name, 'Tommy',
'... got the right first name' );
is( $ii->employees->[1]->last_name, 'Lee', '... got the right last name' );
ok( !$ii->employees->[1]->has_middle_initial, '... no middle initial' );
is( $ii->employees->[1]->middle_initial, undef,
'... got the right middle initial value' );
is( $ii->employees->[1]->full_name,
'Tommy Lee, Vice President / Senior Developer',
'... got the right full name' );
is( $ii->employees->[1]->title, 'Vice President / Senior Developer',
'... got the right title' );
is( $ii->employees->[1]->employer, $ii, '... got the right company' );
ok( isweak( $ii->employees->[1]->{employer} ),
'... the company is a weak-ref' );
isa_ok( $ii->employees->[1]->address, 'Address' );
is( $ii->employees->[1]->address->city, 'New York',
'... got the right city' );
is( $ii->employees->[1]->address->state, 'NY', '... got the right state' );
# employee #3
isa_ok( $ii->employees->[2], 'Employee' );
isa_ok( $ii->employees->[2], 'Person' );
is( $ii->employees->[2]->first_name, 'Stevan',
'... got the right first name' );
is( $ii->employees->[2]->last_name, 'Little', '... got the right last name' );
ok( $ii->employees->[2]->has_middle_initial, '... got middle initial' );
is( $ii->employees->[2]->middle_initial, 'C',
'... got the right middle initial value' );
is( $ii->employees->[2]->full_name, 'Stevan C. Little, Senior Developer',
'... got the right full name' );
is( $ii->employees->[2]->title, 'Senior Developer',
'... got the right title' );
is( $ii->employees->[2]->employer, $ii, '... got the right company' );
ok( isweak( $ii->employees->[2]->{employer} ),
'... the company is a weak-ref' );
isa_ok( $ii->employees->[2]->address, 'Address' );
is( $ii->employees->[2]->address->city, 'Madison', '... got the right city' );
is( $ii->employees->[2]->address->state, 'CT', '... got the right state' );
# create new company
my $new_company
= Company->new( name => 'Infinity Interactive International' );
isa_ok( $new_company, 'Company' );
my $ii_employees = $ii->employees;
foreach my $employee (@$ii_employees) {
is( $employee->employer, $ii, '... has the ii company' );
}
$new_company->employees($ii_employees);
foreach my $employee ( @{ $new_company->employees } ) {
is( $employee->employer, $new_company,
'... has the different company now' );
}
## check some error conditions for the subtypes
isnt(
exception {
Address->new( street => {} ),;
},
undef,
'... we die correctly with bad args'
);
isnt(
exception {
Address->new( city => {} ),;
},
undef,
'... we die correctly with bad args'
);
isnt(
exception {
Address->new( state => 'British Columbia' ),;
},
undef,
'... we die correctly with bad args'
);
is(
exception {
Address->new( state => 'Connecticut' ),;
},
undef,
'... we live correctly with good args'
);
isnt(
exception {
Address->new( zip_code => 'AF5J6$' ),;
},
undef,
'... we die correctly with bad args'
);
is(
exception {
Address->new( zip_code => '06443' ),;
},
undef,
'... we live correctly with good args'
);
isnt(
exception {
Company->new(),;
},
undef,
'... we die correctly without good args'
);
is(
exception {
Company->new( name => 'Foo' ),;
},
undef,
'... we live correctly without good args'
);
isnt(
exception {
Company->new( name => 'Foo', employees => [ Person->new ] ),;
},
undef,
'... we die correctly with good args'
);
is(
exception {
Company->new( name => 'Foo', employees => [] ),;
},
undef,
'... we live correctly with good args'
);
=end testing
=head1 AUTHORS
=over 4
=item *
Stevan Little <stevan@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

127
CPAN/Moose/Cookbook/Basics/DateTime_ExtendingNonMooseParent.pod Normal file
View File

@@ -0,0 +1,127 @@
# PODNAME: Moose::Cookbook::Basics::DateTime_ExtendingNonMooseParent
# ABSTRACT: Extending a non-Moose parent class
__END__
=pod
=encoding UTF-8
=head1 NAME
Moose::Cookbook::Basics::DateTime_ExtendingNonMooseParent - Extending a non-Moose parent class
=head1 VERSION
version 2.2207
=head1 SYNOPSIS
package My::DateTime;
use Moose;
use MooseX::NonMoose;
use DateTime::Calendar::Mayan;
extends qw( DateTime );
has 'mayan_date' => (
is => 'ro',
isa => 'DateTime::Calendar::Mayan',
init_arg => undef,
lazy => 1,
builder => '_build_mayan_date',
clearer => '_clear_mayan_date',
predicate => 'has_mayan_date',
);
after 'set' => sub {
$_[0]->_clear_mayan_date;
};
sub _build_mayan_date {
DateTime::Calendar::Mayan->from_object( object => $_[0] );
}
=head1 DESCRIPTION
This recipe demonstrates how to use Moose to subclass a parent which
is not Moose based. This recipe only works if the parent class uses a
blessed hash reference for object instances. If your parent is doing
something funkier, you should check out L<MooseX::NonMoose::InsideOut> and L<MooseX::InsideOut>.
The meat of this recipe is contained in L<MooseX::NonMoose>, which does all
the grunt work for you.
=for testing-SETUP use Test::Needs {
'DateTime' => '0',
'DateTime::Calendar::Mayan' => '0',
'MooseX::NonMoose' => '0.25',
};
=begin testing
my $dt = My::DateTime->new( year => 1970, month => 2, day => 24 );
can_ok( $dt, 'mayan_date' );
isa_ok( $dt->mayan_date, 'DateTime::Calendar::Mayan' );
is( $dt->mayan_date->date, '12.17.16.9.19', 'got expected mayan date' );
$dt->set( year => 2009 );
ok( ! $dt->has_mayan_date, 'mayan_date is cleared after call to ->set' );
=end testing
=head1 AUTHORS
=over 4
=item *
Stevan Little <stevan@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

197
CPAN/Moose/Cookbook/Basics/Document_AugmentAndInner.pod Normal file
View File

@@ -0,0 +1,197 @@
# PODNAME: Moose::Cookbook::Basics::Document_AugmentAndInner
# ABSTRACT: The augment modifier, which turns normal method overriding "inside-out"
__END__
=pod
=encoding UTF-8
=head1 NAME
Moose::Cookbook::Basics::Document_AugmentAndInner - The augment modifier, which turns normal method overriding "inside-out"
=head1 VERSION
version 2.2207
=head1 SYNOPSIS
package Document::Page;
use Moose;
has 'body' => ( is => 'rw', isa => 'Str', default => sub {''} );
sub create {
my $self = shift;
$self->open_page;
inner();
$self->close_page;
}
sub append_body {
my ( $self, $appendage ) = @_;
$self->body( $self->body . $appendage );
}
sub open_page { (shift)->append_body('<page>') }
sub close_page { (shift)->append_body('</page>') }
package Document::PageWithHeadersAndFooters;
use Moose;
extends 'Document::Page';
augment 'create' => sub {
my $self = shift;
$self->create_header;
inner();
$self->create_footer;
};
sub create_header { (shift)->append_body('<header/>') }
sub create_footer { (shift)->append_body('<footer/>') }
package TPSReport;
use Moose;
extends 'Document::PageWithHeadersAndFooters';
augment 'create' => sub {
my $self = shift;
$self->create_tps_report;
inner();
};
sub create_tps_report {
(shift)->append_body('<report type="tps"/>');
}
# <page><header/><report type="tps"/><footer/></page>
my $report_xml = TPSReport->new->create;
=head1 DESCRIPTION
This recipe shows how the C<augment> method modifier works. This
modifier reverses the normal subclass to parent method resolution
order. With an C<augment> modifier the I<least> specific method is
called first. Each successive call to C<inner> descends the
inheritance tree, ending at the most specific subclass.
The C<augment> modifier lets you design a parent class that can be
extended in a specific way. The parent provides generic wrapper
functionality, and the subclasses fill in the details.
In the example above, we've created a set of document classes, with
the most specific being the C<TPSReport> class.
We start with the least specific class, C<Document::Page>. Its create
method contains a call to C<inner()>:
sub create {
my $self = shift;
$self->open_page;
inner();
$self->close_page;
}
The C<inner> function is exported by C<Moose>, and is like C<super>
for augmented methods. When C<inner> is called, Moose finds the next
method in the chain, which is the C<augment> modifier in
C<Document::PageWithHeadersAndFooters>. You'll note that we can call
C<inner> in our modifier:
augment 'create' => sub {
my $self = shift;
$self->create_header;
inner();
$self->create_footer;
};
This finds the next most specific modifier, in the C<TPSReport> class.
Finally, in the C<TPSReport> class, the chain comes to an end:
augment 'create' => sub {
my $self = shift;
$self->create_tps_report;
inner();
};
We do call the C<inner> function one more time, but since there is no
more specific subclass, this is a no-op. Making this call means we can
easily subclass C<TPSReport> in the future.
=head1 CONCLUSION
The C<augment> modifier is a powerful tool for creating a set of
nested wrappers. It's not something you will need often, but when you
do, it is very handy.
=begin testing
my $tps_report = TPSReport->new;
isa_ok( $tps_report, 'TPSReport' );
is(
$tps_report->create,
q{<page><header/><report type="tps"/><footer/></page>},
'... got the right TPS report'
);
=end testing
=head1 AUTHORS
=over 4
=item *
Stevan Little <stevan@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

318
CPAN/Moose/Cookbook/Basics/Genome_OverloadingSubtypesAndCoercion.pod Normal file
View File

@@ -0,0 +1,318 @@
# PODNAME: Moose::Cookbook::Basics::Genome_OverloadingSubtypesAndCoercion
# ABSTRACT: Operator overloading, subtypes, and coercion
__END__
=pod
=encoding UTF-8
=head1 NAME
Moose::Cookbook::Basics::Genome_OverloadingSubtypesAndCoercion - Operator overloading, subtypes, and coercion
=head1 VERSION
version 2.2207
=head1 SYNOPSIS
package Human;
use Moose;
use Moose::Util::TypeConstraints;
subtype 'Sex'
=> as 'Str'
=> where { $_ =~ m{^[mf]$}s };
has 'sex' => ( is => 'ro', isa => 'Sex', 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->sex() eq $two->sex() );
my ( $mother, $father )
= ( $one->sex eq 'f' ? ( $one, $two ) : ( $two, $one ) );
my $sex = 'f';
$sex = 'm' if ( rand() >= 0.5 );
return Human->new(
sex => $sex,
mother => $mother,
father => $father,
);
}
=head1 DESCRIPTION
This Moose cookbook recipe shows how operator overloading, coercion,
and subtypes 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 sex. 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 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 supplying 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 is 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 two 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::Util 1.56 qw( mesh );
coerce 'Human::EyeColor'
=> from 'ArrayRef'
=> via { my @genes = qw( bey2_1 bey2_2 gey_1 gey_2 );
return Human::EyeColor->new( mesh ( \@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(
sex => $sex,
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/recipes/basics_genome_overloadingsubtypesandcoercion.t>.
=head1 NEXT STEPS
Had this been a real project we'd probably want:
=over 4
=item Better Randomization with Crypt::Random
=item Characteristic Base Class
=item Mutating Genes
=item More Characteristics
=item Artificial Life
=back
=head1 AUTHORS
=over 4
=item *
Stevan Little <stevan@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND 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

345
CPAN/Moose/Cookbook/Basics/HTTP_SubtypesAndCoercion.pod Normal file
View File

@@ -0,0 +1,345 @@
# PODNAME: Moose::Cookbook::Basics::HTTP_SubtypesAndCoercion
# ABSTRACT: Demonstrates subtypes and coercion use HTTP-related classes (Request, Protocol, etc.)
__END__
=pod
=encoding UTF-8
=head1 NAME
Moose::Cookbook::Basics::HTTP_SubtypesAndCoercion - Demonstrates subtypes and coercion use HTTP-related classes (Request, Protocol, etc.)
=head1 VERSION
version 2.2207
=head1 SYNOPSIS
package Request;
use Moose;
use Moose::Util::TypeConstraints;
use HTTP::Headers ();
use Params::Coerce ();
use URI ();
subtype 'My::Types::HTTP::Headers' => as class_type('HTTP::Headers');
coerce 'My::Types::HTTP::Headers'
=> from 'ArrayRef'
=> via { HTTP::Headers->new( @{$_} ) }
=> from 'HashRef'
=> via { HTTP::Headers->new( %{$_} ) };
subtype 'My::Types::URI' => as class_type('URI');
coerce 'My::Types::URI'
=> from 'Object'
=> via { $_->isa('URI')
? $_
: Params::Coerce::coerce( 'URI', $_ ); }
=> from 'Str'
=> via { URI->new( $_, 'http' ) };
subtype 'Protocol'
=> as 'Str'
=> where { /^HTTP\/[0-9]\.[0-9]$/ };
has 'base' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 );
has 'uri' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 );
has 'method' => ( is => 'rw', isa => 'Str' );
has 'protocol' => ( is => 'rw', isa => 'Protocol' );
has 'headers' => (
is => 'rw',
isa => 'My::Types::HTTP::Headers',
coerce => 1,
default => sub { HTTP::Headers->new }
);
=head1 DESCRIPTION
This recipe introduces type coercions, which are defined with the
C<coerce> sugar function. Coercions are attached to existing type
constraints, and define a (one-way) transformation from one type to
another.
This is very powerful, but it can also have unexpected consequences, so
you have to explicitly ask for an attribute to be coerced. To do this,
you must set the C<coerce> attribute option to a true value.
First, we create the subtype to which we will coerce the other types:
subtype 'My::Types::HTTP::Headers' => as class_type('HTTP::Headers');
We are creating a subtype rather than using C<HTTP::Headers> as a type
directly. The reason we do this is that coercions are global, and a
coercion defined for C<HTTP::Headers> in our C<Request> class would
then be defined for I<all> Moose-using classes in the current Perl
interpreter. It's a L<best practice|Moose::Manual::BestPractices> to
avoid this sort of namespace pollution.
The C<class_type> sugar function is simply a shortcut for this:
subtype 'HTTP::Headers'
=> as 'Object'
=> where { $_->isa('HTTP::Headers') };
Internally, Moose creates a type constraint for each Moose-using
class, but for non-Moose classes, the type must be declared
explicitly.
We could go ahead and use this new type directly:
has 'headers' => (
is => 'rw',
isa => 'My::Types::HTTP::Headers',
default => sub { HTTP::Headers->new }
);
This creates a simple attribute which defaults to an empty instance of
L<HTTP::Headers>.
The constructor for L<HTTP::Headers> accepts a list of key-value pairs
representing the HTTP header fields. In Perl, such a list could be
stored in an ARRAY or HASH reference. We want our C<headers> attribute
to accept those data structures instead of an B<HTTP::Headers>
instance, and just do the right thing. This is exactly what coercion
is for:
coerce 'My::Types::HTTP::Headers'
=> from 'ArrayRef'
=> via { HTTP::Headers->new( @{$_} ) }
=> from 'HashRef'
=> via { HTTP::Headers->new( %{$_} ) };
The first argument to C<coerce> is the type I<to> which we are
coercing. Then we give it a set of C<from>/C<via> clauses. The C<from>
function takes some other type name and C<via> takes a subroutine
reference which actually does the coercion.
However, defining the coercion doesn't do anything until we tell Moose
we want a particular attribute to be coerced:
has 'headers' => (
is => 'rw',
isa => 'My::Types::HTTP::Headers',
coerce => 1,
default => sub { HTTP::Headers->new }
);
Now, if we use an C<ArrayRef> or C<HashRef> to populate C<headers>, it
will be coerced into a new L<HTTP::Headers> instance. With the
coercion in place, 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 } );
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. (1)
Our next coercion shows how we can leverage existing CPAN modules to
help implement coercions. In this case we use L<Params::Coerce>.
Once again, we need to declare a class type for our non-Moose L<URI>
class:
subtype 'My::Types::URI' => as class_type('URI');
Then we define the coercion:
coerce 'My::Types::URI'
=> from 'Object'
=> via { $_->isa('URI')
? $_
: Params::Coerce::coerce( 'URI', $_ ); }
=> from 'Str'
=> via { URI->new( $_, 'http' ) };
The first coercion takes any object and makes it a C<URI> object. The
coercion system isn't that smart, and does not check if the object is
already a L<URI>, so we check for that ourselves. If it's not a L<URI>
already, we let L<Params::Coerce> do its magic, and we just use its
return value.
If L<Params::Coerce> didn't return a L<URI> object (for whatever
reason), Moose would throw a type constraint error.
The other coercion takes a string and converts it to a L<URI>. In this
case, we are using the coercion to apply a default behavior, where a
string is assumed to be an C<http> URI.
Finally, we need to make sure our attributes enable coercion.
has 'base' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 );
has 'uri' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 );
Re-using the coercion lets us enforce a consistent API across multiple
attributes.
=for testing-SETUP use Test::Needs {
'HTTP::Headers' => '0',
'Params::Coerce' => '0',
'URI' => '0',
};
=head1 CONCLUSION
This recipe showed the use of coercions to create a more flexible and
DWIM-y API. Like any powerful feature, we recommend some
caution. Sometimes it's better to reject a value than just guess at
how to DWIM.
We also showed the use of the C<class_type> sugar function as a
shortcut for defining a new subtype of C<Object>.
=head1 FOOTNOTES
=over 4
=item (1)
This particular example could be safer. Really we only want to coerce
an array with an I<even> number of elements. We could create a new
C<EvenElementArrayRef> type, and then coerce from that type, as
opposed to a plain C<ArrayRef>
=back
=begin testing
my $r = Request->new;
isa_ok( $r, 'Request' );
{
my $header = $r->headers;
isa_ok( $header, 'HTTP::Headers' );
is( $r->headers->content_type, '',
'... got no content type in the header' );
$r->headers( { content_type => 'text/plain' } );
my $header2 = $r->headers;
isa_ok( $header2, 'HTTP::Headers' );
isnt( $header, $header2, '... created a new HTTP::Header object' );
is( $header2->content_type, 'text/plain',
'... got the right content type in the header' );
$r->headers( [ content_type => 'text/html' ] );
my $header3 = $r->headers;
isa_ok( $header3, 'HTTP::Headers' );
isnt( $header2, $header3, '... created a new HTTP::Header object' );
is( $header3->content_type, 'text/html',
'... got the right content type in the header' );
$r->headers( HTTP::Headers->new( content_type => 'application/pdf' ) );
my $header4 = $r->headers;
isa_ok( $header4, 'HTTP::Headers' );
isnt( $header3, $header4, '... created a new HTTP::Header object' );
is( $header4->content_type, 'application/pdf',
'... got the right content type in the header' );
isnt(
exception {
$r->headers('Foo');
},
undef,
'... dies when it gets bad params'
);
}
{
is( $r->protocol, undef, '... got nothing by default' );
is(
exception {
$r->protocol('HTTP/1.0');
},
undef,
'... set the protocol correctly'
);
is( $r->protocol, 'HTTP/1.0', '... got nothing by default' );
isnt(
exception {
$r->protocol('http/1.0');
},
undef,
'... the protocol died with bar params correctly'
);
}
{
$r->base('http://localhost/');
isa_ok( $r->base, 'URI' );
$r->uri('http://localhost/');
isa_ok( $r->uri, 'URI' );
}
=end testing
=head1 AUTHORS
=over 4
=item *
Stevan Little <stevan@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

99
CPAN/Moose/Cookbook/Basics/Immutable.pod Normal file
View File

@@ -0,0 +1,99 @@
# PODNAME: Moose::Cookbook::Basics::Immutable
# ABSTRACT: Making Moose fast by making your class immutable
__END__
=pod
=encoding UTF-8
=head1 NAME
Moose::Cookbook::Basics::Immutable - Making Moose fast by making your class immutable
=head1 VERSION
version 2.2207
=head1 SYNOPSIS
package Point;
use Moose;
has 'x' => ( isa => 'Int', is => 'ro' );
has 'y' => ( isa => 'Int', is => 'rw' );
__PACKAGE__->meta->make_immutable;
=head1 DESCRIPTION
The Moose metaclass API provides a C<make_immutable()> method. Calling
this method does two things to your class. First, it makes it
faster. In particular, object construction and destruction are
effectively "inlined" in your class, and no longer invoke the meta
API.
Second, you can no longer make changes via the metaclass API, such as
adding attributes. In practice, this won't be a problem, as you rarely
need to do this after first loading the class.
=head1 CONCLUSION
We strongly recommend you make your classes immutable. It makes your
code much faster, with a small compile-time cost. This will be
especially noticeable when creating many objects.
=head1 AUTHORS
=over 4
=item *
Stevan Little <stevan@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

180
CPAN/Moose/Cookbook/Basics/Person_BUILDARGSAndBUILD.pod Normal file
View File

@@ -0,0 +1,180 @@
# PODNAME: Moose::Cookbook::Basics::Person_BUILDARGSAndBUILD
# ABSTRACT: Using BUILDARGS and BUILD to hook into object construction
__END__
=pod
=encoding UTF-8
=head1 NAME
Moose::Cookbook::Basics::Person_BUILDARGSAndBUILD - Using BUILDARGS and BUILD to hook into object construction
=head1 VERSION
version 2.2207
=head1 SYNOPSIS
package Person;
has 'ssn' => (
is => 'ro',
isa => 'Str',
predicate => 'has_ssn',
);
has 'country_of_residence' => (
is => 'ro',
isa => 'Str',
default => 'usa'
);
has 'first_name' => (
is => 'ro',
isa => 'Str',
);
has 'last_name' => (
is => 'ro',
isa => 'Str',
);
around BUILDARGS => sub {
my $orig = shift;
my $class = shift;
if ( @_ == 1 && ! ref $_[0] ) {
return $class->$orig(ssn => $_[0]);
}
else {
return $class->$orig(@_);
}
};
sub BUILD {
my $self = shift;
if ( $self->country_of_residence eq 'usa' ) {
die 'Cannot create a Person who lives in the USA without an ssn.'
unless $self->has_ssn;
}
}
=head1 DESCRIPTION
This recipe demonstrates the use of C<BUILDARGS> and C<BUILD>. By
defining these methods, we can hook into the object construction
process without overriding C<new>.
The C<BUILDARGS> method is called I<before> an object has been
created. It is called as a class method, and receives all of the
parameters passed to the C<new> method. It is expected to do something
with these arguments and return a hash reference. The keys of the hash
must be attribute C<init_arg>s.
The primary purpose of C<BUILDARGS> is to allow a class to accept
something other than named arguments. In the case of our C<Person>
class, we are allowing it to be called with a single argument, a
social security number:
my $person = Person->new('123-45-6789');
The key part of our C<BUILDARGS> is this conditional:
if ( @_ == 1 && ! ref $_[0] ) {
return $class->$orig(ssn => $_[0]);
}
By default, Moose constructors accept a list of key-value pairs, or a
hash reference. We need to make sure that C<$_[0]> is not a reference
before assuming it is a social security number.
We call the original C<BUILDARGS> method to handle all the other
cases. You should always do this in your own C<BUILDARGS> methods,
since L<Moose::Object> provides its own C<BUILDARGS> method that
handles hash references and a list of key-value pairs.
The C<BUILD> method is called I<after> the object is constructed, but
before it is returned to the caller. The C<BUILD> method provides an
opportunity to check the object state as a whole. This is a good place
to put logic that cannot be expressed as a type constraint on a single
attribute.
In the C<Person> class, we need to check the relationship between two
attributes, C<ssn> and C<country_of_residence>. We throw an exception
if the object is not logically consistent.
=head1 MORE CONSIDERATIONS
This recipe is made significantly simpler because all of the
attributes are read-only. If the C<country_of_residence> attribute
were settable, we would need to check that a Person had an C<ssn> if
the new country was C<usa>. This could be done with a C<before>
modifier.
=head1 CONCLUSION
We have repeatedly discouraged overriding C<new> in Moose
classes. This recipe shows how you can use C<BUILDARGS> and C<BUILD>
to hook into object construction without overriding C<new>.
The C<BUILDARGS> method lets us expand on Moose's built-in parameter
handling for constructors. The C<BUILD> method lets us implement
logical constraints across the whole object after it is created.
=head1 AUTHORS
=over 4
=item *
Stevan Little <stevan@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

489
CPAN/Moose/Cookbook/Basics/Point_AttributesAndSubclassing.pod Normal file
View File

@@ -0,0 +1,489 @@
# PODNAME: Moose::Cookbook::Basics::Point_AttributesAndSubclassing
# ABSTRACT: Point and Point3D classes, showing basic attributes and subclassing.
__END__
=pod
=encoding UTF-8
=head1 NAME
Moose::Cookbook::Basics::Point_AttributesAndSubclassing - Point and Point3D classes, showing basic attributes and subclassing.
=head1 VERSION
version 2.2207
=head1 SYNOPSIS
package Point;
use Moose;
has 'x' => (isa => 'Int', is => 'rw', required => 1);
has 'y' => (isa => 'Int', is => 'rw', required => 1);
sub clear {
my $self = shift;
$self->x(0);
$self->y(0);
}
package Point3D;
use Moose;
extends 'Point';
has 'z' => (isa => 'Int', is => 'rw', required => 1);
after 'clear' => sub {
my $self = shift;
$self->z(0);
};
package main;
# hash or hashrefs are ok for the constructor
my $point1 = Point->new(x => 5, y => 7);
my $point2 = Point->new({x => 5, y => 7});
my $point3d = Point3D->new(x => 5, y => 42, z => -5);
=head1 DESCRIPTION
This is the classic Point example. It is taken directly from the Perl
6 Apocalypse 12 document, and is similar to the example found in the
classic K&R C book as well.
As with all Perl 5 classes, a Moose class is defined in a package.
Moose handles turning on C<strict> and C<warnings> for us, so all we
need to do is say C<use Moose>, and no kittens will die.
When Moose is loaded, it exports a set of sugar functions into our
package. This means that we import some functions which serve as Moose
"keywords". These aren't real language keywords, they're just Perl
functions exported into our package.
Moose automatically makes our package a subclass of L<Moose::Object>.
The L<Moose::Object> class provides us with a constructor that
respects our attributes, as well other features. See L<Moose::Object>
for details.
Now, onto the keywords. The first one we see here is C<has>, which
defines an instance attribute in our class:
has 'x' => (isa => 'Int', is => 'rw', required => 1);
This will create an attribute named C<x>. The C<isa> parameter says
that we expect the value stored in this attribute to pass the type
constraint for C<Int> (1). The accessor generated for this attribute
will be read-write.
The C<< required => 1 >> parameter means that this attribute must be
provided when a new object is created. A point object without
coordinates doesn't make much sense, so we don't allow it.
We have defined our attributes; next we define our methods. In Moose,
as with regular Perl 5 OO, a method is just a subroutine defined
within the package:
sub clear {
my $self = shift;
$self->x(0);
$self->y(0);
}
That concludes the B<Point> class.
Next we have a subclass of B<Point>, B<Point3D>. To declare our
superclass, we use the Moose keyword C<extends>:
extends 'Point';
The C<extends> keyword works much like C<use base>/C<use parent>. First,
it will attempt to load your class if needed. However, unlike C<base>, the
C<extends> keyword will I<overwrite> any previous values in your
package's C<@ISA>, where C<use base> will C<push> values onto the
package's C<@ISA>.
It is my opinion that the behavior of C<extends> is more intuitive.
(2).
Next we create a new attribute for B<Point3D> called C<z>.
has 'z' => (isa => 'Int', is => 'rw', required => 1);
This attribute is just like B<Point>'s C<x> and C<y> attributes.
The C<after> keyword demonstrates a Moose feature called "method
modifiers" (or "advice" for the AOP inclined):
after 'clear' => sub {
my $self = shift;
$self->z(0);
};
When C<clear> is called on a B<Point3D> object, our modifier method
gets called as well. Unsurprisingly, the modifier is called I<after>
the real method.
In this case, the real C<clear> method is inherited from B<Point>. Our
modifier method receives the same arguments as those passed to the
modified method (just C<$self> here).
Of course, using the C<after> modifier is not the only way to
accomplish this. This B<is> Perl, right? You can get the same results
with this code:
sub clear {
my $self = shift;
$self->SUPER::clear();
$self->z(0);
}
You could also use another Moose method modifier, C<override>:
override 'clear' => sub {
my $self = shift;
super();
$self->z(0);
};
The C<override> modifier allows you to use the C<super> keyword to
dispatch to the superclass's method in a very Ruby-ish style.
The choice of whether to use a method modifier, and which one to use,
is often a question of style as much as functionality.
Since B<Point> inherits from L<Moose::Object>, it will also inherit
the default L<Moose::Object> constructor:
my $point1 = Point->new(x => 5, y => 7);
my $point2 = Point->new({x => 5, y => 7});
my $point3d = Point3D->new(x => 5, y => 42, z => -5);
The C<new> constructor accepts a named argument pair for each
attribute defined by the class, which you can provide as a hash or
hash reference. In this particular example, the attributes are
required, and calling C<new> without them will throw an error.
my $point = Point->new( x => 5 ); # no y, kaboom!
From here on, we can use C<$point> and C<$point3d> just as you would
any other Perl 5 object. For a more detailed example of what can be
done, you can refer to the
F<t/recipes/basics_point_attributesandsubclassing.t> test file.
=head2 Moose Objects are Just Hashrefs
While this all may appear rather magical, it's important to realize
that Moose objects are just hash references under the hood (3). For
example, you could pass C<$self> to C<Data::Dumper> and you'd get
exactly what you'd expect.
You could even poke around inside the object's data structure, but
that is strongly discouraged.
The fact that Moose objects are hashrefs means it is easy to use Moose
to extend non-Moose classes, as long as they too are hash
references. If you want to extend a non-hashref class, check out
C<MooseX::InsideOut>.
=head1 CONCLUSION
This recipe demonstrates some basic Moose concepts, attributes,
subclassing, and a simple method modifier.
=head1 FOOTNOTES
=over 4
=item (1)
Moose provides a number of builtin type constraints, of which C<Int>
is one. For more information on the type constraint system, see
L<Moose::Util::TypeConstraints>.
=item (2)
The C<extends> keyword supports multiple inheritance. Simply pass all
of your superclasses to C<extends> as a list:
extends 'Foo', 'Bar', 'Baz';
=item (3)
Moose supports using instance structures other than blessed hash
references (such as glob references - see L<MooseX::GlobRef>).
=back
=head1 SEE ALSO
=over 4
=item Method Modifiers
The concept of method modifiers is directly ripped off from CLOS. A
great explanation of them can be found by following this link.
L<http://www.gigamonkeys.com/book/object-reorientation-generic-functions.html>
=back
=begin testing
my $point = Point->new( x => 1, y => 2 );
isa_ok( $point, 'Point' );
isa_ok( $point, 'Moose::Object' );
is( $point->x, 1, '... got the right value for x' );
is( $point->y, 2, '... got the right value for y' );
$point->y(10);
is( $point->y, 10, '... got the right (changed) value for y' );
isnt(
exception {
$point->y('Foo');
},
undef,
'... cannot assign a non-Int to y'
);
isnt(
exception {
Point->new();
},
undef,
'... must provide required attributes to new'
);
$point->clear();
is( $point->x, 0, '... got the right (cleared) value for x' );
is( $point->y, 0, '... got the right (cleared) value for y' );
# check the type constraints on the constructor
is(
exception {
Point->new( x => 0, y => 0 );
},
undef,
'... can assign a 0 to x and y'
);
isnt(
exception {
Point->new( x => 10, y => 'Foo' );
},
undef,
'... cannot assign a non-Int to y'
);
isnt(
exception {
Point->new( x => 'Foo', y => 10 );
},
undef,
'... cannot assign a non-Int to x'
);
# Point3D
my $point3d = Point3D->new( { x => 10, y => 15, z => 3 } );
isa_ok( $point3d, 'Point3D' );
isa_ok( $point3d, 'Point' );
isa_ok( $point3d, 'Moose::Object' );
is( $point3d->x, 10, '... got the right value for x' );
is( $point3d->y, 15, '... got the right value for y' );
is( $point3d->{'z'}, 3, '... got the right value for z' );
$point3d->clear();
is( $point3d->x, 0, '... got the right (cleared) value for x' );
is( $point3d->y, 0, '... got the right (cleared) value for y' );
is( $point3d->z, 0, '... got the right (cleared) value for z' );
isnt(
exception {
Point3D->new( x => 10, y => 'Foo', z => 3 );
},
undef,
'... cannot assign a non-Int to y'
);
isnt(
exception {
Point3D->new( x => 'Foo', y => 10, z => 3 );
},
undef,
'... cannot assign a non-Int to x'
);
isnt(
exception {
Point3D->new( x => 0, y => 10, z => 'Bar' );
},
undef,
'... cannot assign a non-Int to z'
);
isnt(
exception {
Point3D->new( x => 10, y => 3 );
},
undef,
'... z is a required attribute for Point3D'
);
# test some class introspection
can_ok( 'Point', 'meta' );
isa_ok( Point->meta, 'Moose::Meta::Class' );
can_ok( 'Point3D', 'meta' );
isa_ok( Point3D->meta, 'Moose::Meta::Class' );
isnt(
Point->meta, Point3D->meta,
'... they are different metaclasses as well'
);
# poke at Point
is_deeply(
[ Point->meta->superclasses ],
['Moose::Object'],
'... Point got the automagic base class'
);
my @Point_methods = qw(meta x y clear);
my @Point_attrs = ( 'x', 'y' );
is_deeply(
[ sort @Point_methods ],
[ sort Point->meta->get_method_list() ],
'... we match the method list for Point'
);
is_deeply(
[ sort @Point_attrs ],
[ sort Point->meta->get_attribute_list() ],
'... we match the attribute list for Point'
);
foreach my $method (@Point_methods) {
ok( Point->meta->has_method($method),
'... Point has the method "' . $method . '"' );
}
foreach my $attr_name (@Point_attrs) {
ok( Point->meta->has_attribute($attr_name),
'... Point has the attribute "' . $attr_name . '"' );
my $attr = Point->meta->get_attribute($attr_name);
ok( $attr->has_type_constraint,
'... Attribute ' . $attr_name . ' has a type constraint' );
isa_ok( $attr->type_constraint, 'Moose::Meta::TypeConstraint' );
is( $attr->type_constraint->name, 'Int',
'... Attribute ' . $attr_name . ' has an Int type constraint' );
}
# poke at Point3D
is_deeply(
[ Point3D->meta->superclasses ],
['Point'],
'... Point3D gets the parent given to it'
);
my @Point3D_methods = qw( meta z clear );
my @Point3D_attrs = ('z');
is_deeply(
[ sort @Point3D_methods ],
[ sort Point3D->meta->get_method_list() ],
'... we match the method list for Point3D'
);
is_deeply(
[ sort @Point3D_attrs ],
[ sort Point3D->meta->get_attribute_list() ],
'... we match the attribute list for Point3D'
);
foreach my $method (@Point3D_methods) {
ok( Point3D->meta->has_method($method),
'... Point3D has the method "' . $method . '"' );
}
foreach my $attr_name (@Point3D_attrs) {
ok( Point3D->meta->has_attribute($attr_name),
'... Point3D has the attribute "' . $attr_name . '"' );
my $attr = Point3D->meta->get_attribute($attr_name);
ok( $attr->has_type_constraint,
'... Attribute ' . $attr_name . ' has a type constraint' );
isa_ok( $attr->type_constraint, 'Moose::Meta::TypeConstraint' );
is( $attr->type_constraint->name, 'Int',
'... Attribute ' . $attr_name . ' has an Int type constraint' );
}
=end testing
=head1 AUTHORS
=over 4
=item *
Stevan Little <stevan@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut