diff options
Diffstat (limited to 'lib/Moose/Cookbook')
28 files changed, 7068 insertions, 0 deletions
diff --git a/lib/Moose/Cookbook/Basics/BankAccount_MethodModifiersAndSubclassing.pod b/lib/Moose/Cookbook/Basics/BankAccount_MethodModifiersAndSubclassing.pod new file mode 100644 index 0000000..f4874e4 --- /dev/null +++ b/lib/Moose/Cookbook/Basics/BankAccount_MethodModifiersAndSubclassing.pod @@ -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.1405 + +=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/moose_cookbook_basics_recipe2.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.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Basics/BinaryTree_AttributeFeatures.pod b/lib/Moose/Cookbook/Basics/BinaryTree_AttributeFeatures.pod new file mode 100644 index 0000000..09cdf3f --- /dev/null +++ b/lib/Moose/Cookbook/Basics/BinaryTree_AttributeFeatures.pod @@ -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.1405 + +=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/moose_cookbook_basics_recipe3.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.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Basics/BinaryTree_BuilderAndLazyBuild.pod b/lib/Moose/Cookbook/Basics/BinaryTree_BuilderAndLazyBuild.pod new file mode 100644 index 0000000..025968a --- /dev/null +++ b/lib/Moose/Cookbook/Basics/BinaryTree_BuilderAndLazyBuild.pod @@ -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.1405 + +=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.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Basics/Company_Subtypes.pod b/lib/Moose/Cookbook/Basics/Company_Subtypes.pod new file mode 100644 index 0000000..1b062f5 --- /dev/null +++ b/lib/Moose/Cookbook/Basics/Company_Subtypes.pod @@ -0,0 +1,602 @@ +# 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.1405 + +=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 of 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/moose_cookbook_basics_recipe4.t>. + +=for testing-SETUP use Test::Requires { + 'Locale::US' => '0', + 'Regexp::Common' => '0', +}; + +=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.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Basics/DateTime_ExtendingNonMooseParent.pod b/lib/Moose/Cookbook/Basics/DateTime_ExtendingNonMooseParent.pod new file mode 100644 index 0000000..89ef739 --- /dev/null +++ b/lib/Moose/Cookbook/Basics/DateTime_ExtendingNonMooseParent.pod @@ -0,0 +1,134 @@ +# 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.1405 + +=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. + +=begin testing-SETUP + +# because MooseX::NonMoose has a version requirement +BEGIN { $Moose::Role::VERSION = 9999 unless $Moose::Role::VERSION } + +use Test::Requires { + 'DateTime' => '0', + 'DateTime::Calendar::Mayan' => '0', + 'MooseX::NonMoose' => '0.25', +}; + +=end testing-SETUP + +=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.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Basics/Document_AugmentAndInner.pod b/lib/Moose/Cookbook/Basics/Document_AugmentAndInner.pod new file mode 100644 index 0000000..1551745 --- /dev/null +++ b/lib/Moose/Cookbook/Basics/Document_AugmentAndInner.pod @@ -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.1405 + +=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.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Basics/Genome_OverloadingSubtypesAndCoercion.pod b/lib/Moose/Cookbook/Basics/Genome_OverloadingSubtypesAndCoercion.pod new file mode 100644 index 0000000..2311ac3 --- /dev/null +++ b/lib/Moose/Cookbook/Basics/Genome_OverloadingSubtypesAndCoercion.pod @@ -0,0 +1,325 @@ +# 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.1405 + +=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::MoreUtils qw( zip ); + + coerce 'Human::EyeColor' + => from 'ArrayRef' + => via { my @genes = qw( bey2_1 bey2_2 gey_1 gey_2 ); + return Human::EyeColor->new( zip( @genes, @{$_} ) ); }; + + has 'eye_color' => ( + is => 'ro', + isa => 'Human::EyeColor', + coerce => 1, + required => 1, + ); + +We also need to modify C<_overload_add()> in the C<Human> class to +account for eye color: + + return Human->new( + 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_recipe9.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 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/> + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Basics/HTTP_SubtypesAndCoercion.pod b/lib/Moose/Cookbook/Basics/HTTP_SubtypesAndCoercion.pod new file mode 100644 index 0000000..8f0783b --- /dev/null +++ b/lib/Moose/Cookbook/Basics/HTTP_SubtypesAndCoercion.pod @@ -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.1405 + +=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::Requires { + '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.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Basics/Immutable.pod b/lib/Moose/Cookbook/Basics/Immutable.pod new file mode 100644 index 0000000..c8dacbd --- /dev/null +++ b/lib/Moose/Cookbook/Basics/Immutable.pod @@ -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.1405 + +=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.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Basics/Person_BUILDARGSAndBUILD.pod b/lib/Moose/Cookbook/Basics/Person_BUILDARGSAndBUILD.pod new file mode 100644 index 0000000..5262d06 --- /dev/null +++ b/lib/Moose/Cookbook/Basics/Person_BUILDARGSAndBUILD.pod @@ -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.1405 + +=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.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Basics/Point_AttributesAndSubclassing.pod b/lib/Moose/Cookbook/Basics/Point_AttributesAndSubclassing.pod new file mode 100644 index 0000000..25a55aa --- /dev/null +++ b/lib/Moose/Cookbook/Basics/Point_AttributesAndSubclassing.pod @@ -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.1405 + +=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/moose_cookbook_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.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Extending/Debugging_BaseClassRole.pod b/lib/Moose/Cookbook/Extending/Debugging_BaseClassRole.pod new file mode 100644 index 0000000..af1ba0a --- /dev/null +++ b/lib/Moose/Cookbook/Extending/Debugging_BaseClassRole.pod @@ -0,0 +1,152 @@ +# PODNAME: Moose::Cookbook::Extending::Debugging_BaseClassRole +# ABSTRACT: Providing a role for the base object class + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Cookbook::Extending::Debugging_BaseClassRole - Providing a role for the base object class + +=head1 VERSION + +version 2.1405 + +=head1 SYNOPSIS + + package MooseX::Debugging; + + use Moose::Exporter; + + Moose::Exporter->setup_import_methods( + base_class_roles => ['MooseX::Debugging::Role::Object'], + ); + + package MooseX::Debugging::Role::Object; + + use Moose::Role; + + sub BUILD {} + after BUILD => sub { + my $self = shift; + + warn "Made a new " . ( ref $self ) . " object\n"; + }; + +=head1 DESCRIPTION + +In this example, we provide a role for the base object class that adds +some simple debugging output. Every time an object is created, it +spits out a warning saying what type of object it was. + +Obviously, a real debugging role would do something more interesting, +but this recipe is all about how we apply that role. + +In this case, with the combination of L<Moose::Exporter> and +L<Moose::Util::MetaRole>, we ensure that when a module does C<S<use +MooseX::Debugging>>, it automatically gets the debugging role applied +to its base object class. + +There are a few pieces of code worth looking at more closely. + + Moose::Exporter->setup_import_methods( + base_class_roles => ['MooseX::Debugging::Role::Object'], + ); + +This creates an C<import> method in the C<MooseX::Debugging> package. Since we +are not actually exporting anything, we do not pass C<setup_import_methods> +any parameters related to exports, but we need to have an C<import> method to +ensure that our C<init_meta> method is called. The C<init_meta> is created by +C<setup_import_methods> for us, since we passed the C<base_class_roles> +parameter. The generated C<init_meta> will in turn call +L<Moose::Util::MetaRole::apply_base_class_roles|Moose::Util::MetaRole/apply_base_class_roles>. + + sub BUILD {} + after BUILD => sub { + ... + }; + +Due to the way role composition currently works, if the class that a role is +composed into contains a C<BUILD> method, then that will override the C<BUILD> +method in any roles it composes, which is typically not what you want. Using a +method modifier on C<BUILD> avoids this issue, since method modifiers compose +together rather than being overridden. Method modifiers require that a method +exists in order to wrap, however, so we also provide a stub method to wrap if +no C<BUILD> method exists in the class. + +=for testing-SETUP use Test::Requires 'Test::Output'; + +=begin testing + +{ + package Debugged; + + use Moose; + MooseX::Debugging->import; +} + +stderr_is( + sub { Debugged->new }, + "Made a new Debugged object\n", + 'got expected output from debugging role' +); + +=end testing + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Extending/ExtensionOverview.pod b/lib/Moose/Cookbook/Extending/ExtensionOverview.pod new file mode 100644 index 0000000..2dbd898 --- /dev/null +++ b/lib/Moose/Cookbook/Extending/ExtensionOverview.pod @@ -0,0 +1,404 @@ +# PODNAME: Moose::Cookbook::Extending::ExtensionOverview +# ABSTRACT: Moose extension overview + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Cookbook::Extending::ExtensionOverview - Moose extension overview + +=head1 VERSION + +version 2.1405 + +=head1 DESCRIPTION + +Moose provides several ways in which extensions can hook into Moose +and change its behavior. Moose also has a lot of behavior that can be +changed. This recipe will provide an overview of each extension method +and give you some recommendations on what tools to use. + +If you haven't yet read the recipes on metaclasses, go read those +first. You can't write Moose extensions without understanding the +metaclasses, and those recipes also demonstrate some basic extension +mechanisms, such as metaclass subclasses and traits. + +=head2 Playing Nice With Others + +One of the goals of this overview is to help you build extensions that +cooperate well with other extensions. This is especially important if +you plan to release your extension to CPAN. + +Moose comes with several modules that exist to help your write +cooperative extensions. These are L<Moose::Exporter> and +L<Moose::Util::MetaRole>. By using these two modules, you will ensure +that your extension works with both the Moose core features and any +other CPAN extension using those modules. + +=head1 PARTS OF Moose YOU CAN EXTEND + +The types of things you might want to do in Moose extensions fall into +a few broad categories. + +=head2 Metaclass Extensions + +One way of extending Moose is by extending one or more Moose +metaclasses. For example, in L<Moose::Cookbook::Meta::Table_MetaclassTrait> we saw +a metaclass role that added a C<table> attribute to the +metaclass. If you were writing an ORM, this would be a logical +extension. + +Many of the Moose extensions on CPAN work by providing an attribute +metaclass role. For example, the L<MooseX::Aliases> module +provides an attribute metaclass trait that lets you specify aliases +to install for methods and attribute accessors. + +A metaclass extension can be packaged as a role/trait or a subclass. If you +can, we recommend using traits instead of subclasses, since it's much easier +to combine disparate traits than it is to combine a bunch of subclasses. + +When your extensions are implemented as roles, you can apply them with +the L<Moose::Util::MetaRole> module. + +=head2 Providing Sugar Functions + +As part of a metaclass extension, you may also want to provide some +sugar functions, just like L<Moose.pm|Moose> does. Moose provides a +helper module called L<Moose::Exporter> that makes this much +simpler. We will be use L<Moose::Exporter> in several of the extension +recipes. + +=head2 Object Class Extensions + +Another common Moose extension technique is to change the default object +class's behavior. As with metaclass extensions, this can be done with a +role/trait or with a subclass. For example, L<MooseX::StrictConstructor> +extension applies a trait that makes the constructor reject arguments which +don't match its attributes. + +Object class extensions often include metaclass extensions as well. In +particular, if you want your object extension to work when a class is +made immutable, you may need to modify the behavior of some or all of the +L<Moose::Meta::Instance>, L<Moose::Meta::Method::Constructor>, and +L<Moose::Meta::Method::Destructor> objects. + +The L<Moose::Util::MetaRole> module lets you apply roles to the base +object class, as well as the meta classes just mentioned. + +=head2 Providing a Role + +Some extensions come in the form of a role for you to consume. The +L<MooseX::Object::Pluggable> extension is a great example of this. In +fact, despite the C<MooseX> name, it does not actually change anything +about Moose's behavior. Instead, it is just a role that an object +which wants to be pluggable can consume. + +If you are implementing this sort of extension, you don't need to do +anything special. You simply create a role and document that it should +be used via the normal C<with> sugar: + + package MyApp::User; + + use Moose; + + with 'My::Role'; + +Don't use "MooseX" in the name for such packages. + +=head2 New Types + +Another common Moose extension is a new type for the Moose type +system. In this case, you simply create a type in your module. When +people load your module, the type is created, and they can refer to it +by name after that. The L<MooseX::Types::URI> and +L<MooseX::Types::DateTime> distributions are two good examples of how +this works. These both build on top of the L<MooseX::Types> extension. + +=head1 ROLES VS TRAITS VS SUBCLASSES + +It is important to understand that B<roles and traits are the same thing>. A +trait is simply a role applied to a instance. The only thing that may +distinguish the two is that a trait can be packaged in a way that lets Moose +resolve a short name to a class name. In other words, with a trait, the caller +can refer to it by a short name like "Big", and Moose will resolve it to a +class like C<MooseX::Embiggen::Meta::Attribute::Role::Big>. + +See L<Moose::Cookbook::Meta::Labeled_AttributeTrait> and +L<Moose::Cookbook::Meta::Table_MetaclassTrait> for examples of traits in +action. In particular, both of these recipes demonstrate the trait resolution +mechanism. + +Implementing an extension as a (set of) metaclass or base object +role(s) will make your extension more cooperative. It is hard for an +end-user to effectively combine together multiple metaclass +subclasses, but it is very easy to combine roles. + +=head1 USING YOUR EXTENSION + +There are a number of ways in which an extension can be applied. In +some cases you can provide multiple ways of consuming your extension. + +=head2 Extensions as Metaclass Traits + +If your extension is available as a trait, you can ask end users to +simply specify it in a list of traits. Currently, this only works for +(class) metaclass and attribute metaclass traits: + + use Moose -traits => [ 'Big', 'Blue' ]; + + has 'animal' => ( + traits => [ 'Big', 'Blue' ], + ... + ); + +If your extension applies to any other metaclass, or the object base +class, you cannot use the trait mechanism. + +The benefit of the trait mechanism is that is very easy to see where a +trait is applied in the code, and consumers have fine-grained control +over what the trait applies to. This is especially true for attribute +traits, where you can apply the trait to just one attribute in a +class. + +=head2 Extensions as Metaclass (and Base Object) Roles + +Implementing your extensions as metaclass roles makes your extensions +easy to apply, and cooperative with other role-based extensions for +metaclasses. + +Just as with a subclass, you will probably want to package your +extensions for consumption with a single module that uses +L<Moose::Exporter>. However, in this case, you will use +L<Moose::Util::MetaRole> to apply all of your roles. The advantage of +using this module is that I<it preserves any subclassing or roles +already applied to the user's metaclasses>. This means that your +extension is cooperative I<by default>, and consumers of your +extension can easily use it with other role-based extensions. Most +uses of L<Moose::Util::MetaRole> can be handled by L<Moose::Exporter> +directly; see the L<Moose::Exporter> docs. + + package MooseX::Embiggen; + + use Moose::Exporter; + + use MooseX::Embiggen::Role::Meta::Class; + use MooseX::Embiggen::Role::Meta::Attribute; + use MooseX::Embiggen::Role::Meta::Method::Constructor; + use MooseX::Embiggen::Role::Object; + + Moose::Exporter->setup_import_methods( + class_metaroles => { + class => ['MooseX::Embiggen::Role::Meta::Class'], + attribute => ['MooseX::Embiggen::Role::Meta::Attribute'], + constructor => + ['MooseX::Embiggen::Role::Meta::Method::Constructor'], + }, + base_class_roles => ['MooseX::Embiggen::Role::Object'], + ); + +As you can see from this example, you can use L<Moose::Util::MetaRole> +to apply roles to any metaclass, as well as the base object class. If +some other extension has already applied its own roles, they will be +preserved when your extension applies its roles, and vice versa. + +=head2 Providing Sugar + +With L<Moose::Exporter>, you can also export your own sugar functions: + + package MooseX::Embiggen; + + use Moose::Exporter; + + Moose::Exporter->setup_import_methods( + with_meta => ['embiggen'], + class_metaroles => { + class => ['MooseX::Embiggen::Role::Meta::Class'], + }, + ); + + sub embiggen { + my $meta = shift; + $meta->embiggen(@_); + } + +And then the consumer of your extension can use your C<embiggen> sub: + + package Consumer; + + use Moose; + use MooseX::Embiggen; + + extends 'Thing'; + + embiggen ...; + +This can be combined with metaclass and base class roles quite easily. + +=head2 More advanced extensions + +Providing your extension simply as a set of traits that gets applied to the +appropriate metaobjects is easy, but sometimes not sufficient. For instance, +sometimes you need to supply not just a base object role, but an actual base +object class (due to needing to interact with existing systems that only +provide a base class). To write extensions like this, you will need to provide +a custom C<init_meta> method in your exporter. For instance: + + package MooseX::Embiggen; + + use Moose::Exporter; + + my ($import, $unimport, $init_meta) = Moose::Exporter->build_import_methods( + install => ['import', 'unimport'], + with_meta => ['embiggen'], + class_metaroles => { + class => ['MooseX::Embiggen::Role::Meta::Class'], + }, + ); + + sub embiggen { + my $meta = shift; + $meta->embiggen(@_); + } + + sub init_meta { + my $package = shift; + my %options = @_; + if (my $meta = Class::MOP::class_of($options{for_class})) { + if ($meta->isa('Class::MOP::Class')) { + my @supers = $meta->superclasses; + $meta->superclasses('MooseX::Embiggen::Base::Class') + if @supers == 1 && $supers[0] eq 'Moose::Object'; + } + } + $package->$init_meta(%options); + } + +In the previous examples, C<init_meta> was generated for you, but here you must +override it in order to add additional functionality. Some differences to note: + +=over 4 + +=item C<build_import_methods> instead of C<setup_import_methods> + +C<build_import_methods> simply returns the C<import>, C<unimport>, and +C<init_meta> methods, rather than installing them under the appropriate names. +This way, you can write your own methods which wrap the functionality provided +by L<Moose::Exporter>. The C<build_import_methods> sub also takes an +additional C<install> parameter, which tells it to just go ahead and install +these methods (since we don't need to modify them). + +=item C<sub init_meta> + +Next, we must write our C<init_meta> wrapper. The important things to remember +are that it is called as a method, and that C<%options> needs to be passed +through to the existing implementation. We call the base implementation by +using the C<$init_meta> subroutine reference that was returned by +C<build_import_methods> earlier. + +=item Additional implementation + +This extension sets a different default base object class. To do so, it first +checks to see if it's being applied to a class, and then checks to see if +L<Moose::Object> is that class's only superclass, and if so, replaces that with +the superclass that this extension requires. + +Note that two extensions that do this same thing will not work together +properly (the second extension to be loaded won't see L<Moose::Object> as the +base object, since it has already been overridden). This is why using a base +object role is recommended for the general case. + +This C<init_meta> also works defensively, by only applying its functionality if +a metaclass already exists. This makes sure it doesn't break with legacy +extensions which override the metaclass directly (and so must be the first +extension to initialize the metaclass). This is likely not necessary, since +almost no extensions work this way anymore, but just provides an additional +level of protection. The common case of C<use Moose; use MooseX::Embiggen;> +is not affected regardless. + +=back + +This is just one example of what can be done with a custom C<init_meta> method. +It can also be used for preventing an extension from being applied to a role, +doing other kinds of validation on the class being applied to, or pretty much +anything that would otherwise be done in an C<import> method. + +=head1 LEGACY EXTENSION MECHANISMS + +Before the existence of L<Moose::Exporter> and +L<Moose::Util::MetaRole>, there were a number of other ways to extend +Moose. In general, these methods were less cooperative, and only +worked well with a single extension. + +These methods include L<metaclass.pm|metaclass>, L<Moose::Policy> +(which uses L<metaclass.pm|metaclass> under the hood), and various +hacks to do what L<Moose::Exporter> does. Please do not use these for +your own extensions. + +Note that if you write a cooperative extension, it should cooperate +with older extensions, though older extensions generally do not +cooperate with each other. + +=head1 CONCLUSION + +If you can write your extension as one or more metaclass and base +object roles, please consider doing so. Make sure to read the docs for +L<Moose::Exporter> and L<Moose::Util::MetaRole> as well. + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Extending/Mooseish_MooseSugar.pod b/lib/Moose/Cookbook/Extending/Mooseish_MooseSugar.pod new file mode 100644 index 0000000..dcc4e90 --- /dev/null +++ b/lib/Moose/Cookbook/Extending/Mooseish_MooseSugar.pod @@ -0,0 +1,160 @@ +# PODNAME: Moose::Cookbook::Extending::Mooseish_MooseSugar +# ABSTRACT: Acting like Moose.pm and providing sugar Moose-style + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Cookbook::Extending::Mooseish_MooseSugar - Acting like Moose.pm and providing sugar Moose-style + +=head1 VERSION + +version 2.1405 + +=head1 SYNOPSIS + + package MyApp::Mooseish; + + use Moose::Exporter; + + Moose::Exporter->setup_import_methods( + with_meta => ['has_table'], + class_metaroles => { + class => ['MyApp::Meta::Class::Trait::HasTable'], + }, + ); + + sub has_table { + my $meta = shift; + $meta->table(shift); + } + + package MyApp::Meta::Class::Trait::HasTable; + use Moose::Role; + + has table => ( + is => 'rw', + isa => 'Str', + ); + +=head1 DESCRIPTION + +This recipe expands on the use of L<Moose::Exporter> we saw in +L<Moose::Cookbook::Extending::ExtensionOverview> and the class metaclass trait +we saw in L<Moose::Cookbook::Meta::Table_MetaclassTrait>. In this example we +provide our own metaclass trait, and we also export a C<has_table> sugar +function. + +The C<with_meta> parameter specifies a list of functions that should +be wrapped before exporting. The wrapper simply ensures that the +importing package's appropriate metaclass object is the first argument +to the function, so we can do C<S<my $meta = shift;>>. + +See the L<Moose::Exporter> docs for more details on its API. + +=head1 USING MyApp::Mooseish + +The purpose of all this code is to provide a Moose-like +interface. Here's what it would look like in actual use: + + package MyApp::User; + + use namespace::autoclean; + + use Moose; + use MyApp::Mooseish; + + has_table 'User'; + + has 'username' => ( is => 'ro' ); + has 'password' => ( is => 'ro' ); + + sub login { ... } + +=head1 CONCLUSION + +Providing sugar functions can make your extension look much more +Moose-ish. See L<Fey::ORM> for a more extensive example. + +=begin testing + +{ + package MyApp::User; + + use Moose; + MyApp::Mooseish->import; + + has_table( 'User' ); + + has( 'username' => ( is => 'ro' ) ); + has( 'password' => ( is => 'ro' ) ); + + sub login { } +} + +can_ok( MyApp::User->meta, 'table' ); +is( MyApp::User->meta->table, 'User', + 'MyApp::User->meta->table returns User' ); +ok( MyApp::User->can('username'), + 'MyApp::User has username method' ); + +=end testing + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Legacy/Debugging_BaseClassReplacement.pod b/lib/Moose/Cookbook/Legacy/Debugging_BaseClassReplacement.pod new file mode 100644 index 0000000..521452f --- /dev/null +++ b/lib/Moose/Cookbook/Legacy/Debugging_BaseClassReplacement.pod @@ -0,0 +1,182 @@ +# PODNAME: Moose::Cookbook::Legacy::Debugging_BaseClassReplacement +# ABSTRACT: Providing an alternate base object class + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Cookbook::Legacy::Debugging_BaseClassReplacement - Providing an alternate base object class + +=head1 VERSION + +version 2.1405 + +=head1 SYNOPSIS + + package MyApp::Base; + use Moose; + + extends 'Moose::Object'; + + before 'new' => sub { warn "Making a new " . $_[0] }; + + no Moose; + + package MyApp::UseMyBase; + use Moose (); + use Moose::Exporter; + + Moose::Exporter->setup_import_methods( also => 'Moose' ); + + sub init_meta { + shift; + return Moose->init_meta( @_, base_class => 'MyApp::Base' ); + } + +=head1 DESCRIPTION + +B<WARNING: Replacing the base class entirely, as opposed to applying roles to +the base class, is strongly discouraged. This recipe is provided solely for +reference when encountering older code that does this.> + +A common extension is to provide an alternate base class. One way to +do that is to make a C<MyApp::Base> and add C<S<extends +'MyApp::Base'>> to every class in your application. That's pretty +tedious. Instead, you can create a Moose-alike module that sets the +base object class to C<MyApp::Base> for you. + +Then, instead of writing C<S<use Moose>> you can write C<S<use +MyApp::UseMyBase>>. + +In this particular example, our base class issues some debugging +output every time a new object is created, but you can think of some +more interesting things to do with your own base class. + +This uses the magic of L<Moose::Exporter>. When we call C<< +Moose::Exporter->setup_import_methods( also => 'Moose' ) >> it builds +C<import> and C<unimport> methods for you. The C<< also => 'Moose' >> +bit says that we want to export everything that Moose does. + +The C<import> method that gets created will call our C<init_meta> +method, passing it C<< for_caller => $caller >> as its +arguments. The C<$caller> is set to the class that actually imported +us in the first place. + +See the L<Moose::Exporter> docs for more details on its API. + +=for testing-SETUP use Test::Requires 'Test::Output'; + +=head1 USING MyApp::UseMyBase + +To actually use our new base class, we simply use C<MyApp::UseMyBase> +I<instead> of C<Moose>. We get all the Moose sugar plus our new base +class. + + package Foo; + + use MyApp::UseMyBase; + + has 'size' => ( is => 'rw' ); + + no MyApp::UseMyBase; + +=head1 CONCLUSION + +This is an awful lot of magic for a simple base class. You will often +want to combine a metaclass trait with a base class extension, and +that's when this technique is useful. + +=begin testing + +{ + package Foo; + + MyApp::UseMyBase->import; + + has( 'size' => ( is => 'rw' ) ); +} + +ok( Foo->isa('MyApp::Base'), 'Foo isa MyApp::Base' ); + +ok( Foo->can('size'), 'Foo has a size method' ); + +my $foo; +stderr_like( + sub { $foo = Foo->new( size => 2 ) }, + qr/^Making a new Foo/, + 'got expected warning when calling Foo->new' +); + +is( $foo->size(), 2, '$foo->size is 2' ); + +=end testing + +=head1 AUTHOR + +Moose is maintained by the Moose Cabal, along with the help of many contributors. See L<Moose/CABAL> and L<Moose/CONTRIBUTORS> for details. + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 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. + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Legacy/Labeled_AttributeMetaclass.pod b/lib/Moose/Cookbook/Legacy/Labeled_AttributeMetaclass.pod new file mode 100644 index 0000000..813b1d9 --- /dev/null +++ b/lib/Moose/Cookbook/Legacy/Labeled_AttributeMetaclass.pod @@ -0,0 +1,337 @@ +# PODNAME: Moose::Cookbook::Legacy::Labeled_AttributeMetaclass +# ABSTRACT: A meta-attribute, attributes with labels + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Cookbook::Legacy::Labeled_AttributeMetaclass - A meta-attribute, attributes with labels + +=head1 VERSION + +version 2.1405 + +=head1 SYNOPSIS + + package MyApp::Meta::Attribute::Labeled; + use Moose; + extends 'Moose::Meta::Attribute'; + + has label => ( + is => 'rw', + isa => 'Str', + predicate => 'has_label', + ); + + package Moose::Meta::Attribute::Custom::Labeled; + sub register_implementation {'MyApp::Meta::Attribute::Labeled'} + + package MyApp::Website; + use Moose; + + has url => ( + metaclass => 'Labeled', + is => 'rw', + isa => 'Str', + label => "The site's URL", + ); + + has name => ( + is => 'rw', + isa => 'Str', + ); + + sub dump { + my $self = shift; + + my $meta = $self->meta; + + my $dump = ''; + + for my $attribute ( map { $meta->get_attribute($_) } + sort $meta->get_attribute_list ) { + + if ( $attribute->isa('MyApp::Meta::Attribute::Labeled') + && $attribute->has_label ) { + $dump .= $attribute->label; + } + else { + $dump .= $attribute->name; + } + + my $reader = $attribute->get_read_method; + $dump .= ": " . $self->$reader . "\n"; + } + + return $dump; + } + + package main; + + my $app = MyApp::Website->new( url => "http://google.com", name => "Google" ); + +=head1 SUMMARY + +B<WARNING: Subclassing metaclasses (as opposed to providing metaclass traits) +is strongly discouraged. This recipe is provided solely for reference when +encountering older code that does this.> + +In this recipe, we begin to delve into the wonder of meta-programming. +Some readers may scoff and claim that this is the arena of only the +most twisted Moose developers. Absolutely not! Any sufficiently +twisted developer can benefit greatly from going more meta. + +Our goal is to allow each attribute to have a human-readable "label" +attached to it. Such labels would be used when showing data to an end +user. In this recipe we label the C<url> attribute with "The site's +URL" and create a simple method showing how to use that label. + +The proper, modern way to extend attributes (using a role instead of a +subclass) is described in L<Moose::Cookbook::Meta::Recipe3>, but that recipe +assumes you've read and at least tried to understand this one. + +=head1 META-ATTRIBUTE OBJECTS + +All the attributes of a Moose-based object are actually objects +themselves. These objects have methods and attributes. Let's look at +a concrete example. + + has 'x' => ( isa => 'Int', is => 'ro' ); + has 'y' => ( isa => 'Int', is => 'rw' ); + +Internally, the metaclass for C<Point> has two +L<Moose::Meta::Attribute>. There are several methods for getting +meta-attributes out of a metaclass, one of which is +C<get_attribute_list>. This method is called on the metaclass object. + +The C<get_attribute_list> method returns a list of attribute names. You can +then use C<get_attribute> to get the L<Moose::Meta::Attribute> object itself. + +Once you have this meta-attribute object, you can call methods on it like this: + + print $point->meta->get_attribute('x')->type_constraint; + => Int + +To add a label to our attributes there are two steps. First, we need a +new attribute metaclass that can store a label for an +attribute. Second, we need to create attributes that use that +attribute metaclass. + +=head1 RECIPE REVIEW + +We start by creating a new attribute metaclass. + + package MyApp::Meta::Attribute::Labeled; + use Moose; + extends 'Moose::Meta::Attribute'; + +We can subclass a Moose metaclass in the same way that we subclass +anything else. + + has label => ( + is => 'rw', + isa => 'Str', + predicate => 'has_label', + ); + +Again, this is standard Moose code. + +Then we need to register our metaclass with Moose: + + package Moose::Meta::Attribute::Custom::Labeled; + sub register_implementation { 'MyApp::Meta::Attribute::Labeled' } + +This is a bit of magic that lets us use a short name, "Labeled", when +referring to our new metaclass. + +That was the whole attribute metaclass. + +Now we start using it. + + package MyApp::Website; + use Moose; + use MyApp::Meta::Attribute::Labeled; + +We have to load the metaclass to use it, just like any Perl class. + +Finally, we use it for an attribute: + + has url => ( + metaclass => 'Labeled', + is => 'rw', + isa => 'Str', + label => "The site's URL", + ); + +This looks like a normal attribute declaration, except for two things, +the C<metaclass> and C<label> parameters. The C<metaclass> parameter +tells Moose we want to use a custom metaclass for this (one) +attribute. The C<label> parameter will be stored in the meta-attribute +object. + +The reason that we can pass the name C<Labeled>, instead of +C<MyApp::Meta::Attribute::Labeled>, is because of the +C<register_implementation> code we touched on previously. + +When you pass a metaclass to C<has>, it will take the name you provide +and prefix it with C<Moose::Meta::Attribute::Custom::>. Then it calls +C<register_implementation> in the package. In this case, that means +Moose ends up calling +C<Moose::Meta::Attribute::Custom::Labeled::register_implementation>. + +If this function exists, it should return the I<real> metaclass +package name. This is exactly what our code does, returning +C<MyApp::Meta::Attribute::Labeled>. This is a little convoluted, and +if you don't like it, you can always use the fully-qualified name. + +We can access this meta-attribute and its label like this: + + $website->meta->get_attribute('url')->label() + + MyApp::Website->meta->get_attribute('url')->label() + +We also have a regular attribute, C<name>: + + has name => ( + is => 'rw', + isa => 'Str', + ); + +This is a regular Moose attribute, because we have not specified a new +metaclass. + +Finally, we have a C<dump> method, which creates a human-readable +representation of a C<MyApp::Website> object. It will use an +attribute's label if it has one. + + sub dump { + my $self = shift; + + my $meta = $self->meta; + + my $dump = ''; + + for my $attribute ( map { $meta->get_attribute($_) } + sort $meta->get_attribute_list ) { + + if ( $attribute->isa('MyApp::Meta::Attribute::Labeled') + && $attribute->has_label ) { + $dump .= $attribute->label; + } + +This is a bit of defensive code. We cannot depend on every +meta-attribute having a label. Even if we define one for every +attribute in our class, a subclass may neglect to do so. Or a +superclass could add an attribute without a label. + +We also check that the attribute has a label using the predicate we +defined. We could instead make the label C<required>. If we have a +label, we use it, otherwise we use the attribute name: + + else { + $dump .= $attribute->name; + } + + my $reader = $attribute->get_read_method; + $dump .= ": " . $self->$reader . "\n"; + } + + return $dump; + } + +The C<get_read_method> is part of the L<Moose::Meta::Attribute> +API. It returns the name of a method that can read the attribute's +value, I<when called on the real object> (don't call this on the +meta-attribute). + +=head1 CONCLUSION + +You might wonder why you'd bother with all this. You could just +hardcode "The Site's URL" in the C<dump> method. But we want to avoid +repetition. If you need the label once, you may need it elsewhere, +maybe in the C<as_form> method you write next. + +Associating a label with an attribute just makes sense! The label is a +piece of information I<about> the attribute. + +It's also important to realize that this was a trivial example. You +can make much more powerful metaclasses that I<do> things, as opposed +to just storing some more information. For example, you could +implement a metaclass that expires attributes after a certain amount +of time: + + has site_cache => ( + metaclass => 'TimedExpiry', + expires_after => { hours => 1 }, + refresh_with => sub { get( $_[0]->url ) }, + isa => 'Str', + is => 'ro', + ); + +The sky's the limit! + +=for testing my $app = MyApp::Website->new( url => "http://google.com", name => "Google" ); +is( + $app->dump, q{name: Google +The site's URL: http://google.com +}, '... got the expected dump value' +); + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Legacy/Table_ClassMetaclass.pod b/lib/Moose/Cookbook/Legacy/Table_ClassMetaclass.pod new file mode 100644 index 0000000..e264fea --- /dev/null +++ b/lib/Moose/Cookbook/Legacy/Table_ClassMetaclass.pod @@ -0,0 +1,132 @@ +# PODNAME: Moose::Cookbook::Legacy::Table_ClassMetaclass +# ABSTRACT: Adding a "table" attribute to the metaclass + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Cookbook::Legacy::Table_ClassMetaclass - Adding a "table" attribute to the metaclass + +=head1 VERSION + +version 2.1405 + +=head1 SYNOPSIS + + package MyApp::Meta::Class; + use Moose; + extends 'Moose::Meta::Class'; + + has table => ( + is => 'rw', + isa => 'Str', + ); + +=head1 DESCRIPTION + +B<WARNING: Subclassing metaclasses (as opposed to providing metaclass traits) +is strongly discouraged. This recipe is provided solely for reference when +encountering older code that does this.> + +In this recipe, we'll create a new metaclass which has a "table" +attribute. This metaclass is for classes associated with a DBMS table, +as one might do for an ORM. + +In this example, the table name is just a string, but in a real ORM +the table might be an object describing the table. + +=head1 THE METACLASS + +This really is as simple as the recipe L</SYNOPSIS> shows. The trick +is getting your classes to use this metaclass, and providing some sort +of sugar for declaring the table. This is covered in +L<Moose::Cookbook::Extending::Recipe2>, which shows how to make a +module like C<Moose.pm> itself, with sugar like C<has_table()>. + +=head2 Using this Metaclass in Practice + +Accessing this new C<table> attribute is quite simple. Given a class +named C<MyApp::User>, we could simply write the following: + + my $table = MyApp::User->meta->table; + +As long as C<MyApp::User> has arranged to use C<MyApp::Meta::Class> as +its metaclass, this method call just works. If we want to be more +careful, we can check the metaclass's class: + + $table = MyApp::User->meta->table + if MyApp::User->meta->isa('MyApp::Meta::Class'); + +=head1 CONCLUSION + +Creating custom metaclass is trivial. Using it is a little harder, and +is covered in other recipes. We will also talk about applying traits +to a class metaclass, which is a more flexible and cooperative +implementation. + +=head1 SEE ALSO + +L<Moose::Cookbook::Meta::Recipe5> - The "table" attribute implemented +as a metaclass trait + +L<Moose::Cookbook::Extending::Recipe2> - Acting like Moose.pm and +providing sugar Moose-style + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Meta/GlobRef_InstanceMetaclass.pod b/lib/Moose/Cookbook/Meta/GlobRef_InstanceMetaclass.pod new file mode 100644 index 0000000..9ca9f68 --- /dev/null +++ b/lib/Moose/Cookbook/Meta/GlobRef_InstanceMetaclass.pod @@ -0,0 +1,304 @@ +# PODNAME: Moose::Cookbook::Meta::GlobRef_InstanceMetaclass +# ABSTRACT: Creating a glob reference meta-instance class + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Cookbook::Meta::GlobRef_InstanceMetaclass - Creating a glob reference meta-instance class + +=head1 VERSION + +version 2.1405 + +=head1 SYNOPSIS + + package My::Meta::Instance; + + use Scalar::Util qw( weaken ); + use Symbol qw( gensym ); + + use Moose::Role; + + sub create_instance { + my $self = shift; + my $sym = gensym(); + bless $sym, $self->_class_name; + } + + sub clone_instance { + my ( $self, $instance ) = @_; + + my $new_sym = gensym(); + %{*$new_sym} = %{*$instance}; + + bless $new_sym, $self->_class_name; + } + + sub get_slot_value { + my ( $self, $instance, $slot_name ) = @_; + return *$instance->{$slot_name}; + } + + sub set_slot_value { + my ( $self, $instance, $slot_name, $value ) = @_; + *$instance->{$slot_name} = $value; + } + + sub deinitialize_slot { + my ( $self, $instance, $slot_name ) = @_; + delete *$instance->{$slot_name}; + } + + sub is_slot_initialized { + my ( $self, $instance, $slot_name ) = @_; + exists *$instance->{$slot_name}; + } + + sub weaken_slot_value { + my ( $self, $instance, $slot_name ) = @_; + weaken *$instance->{$slot_name}; + } + + sub inline_create_instance { + my ( $self, $class_variable ) = @_; + return 'do { my $sym = Symbol::gensym(); bless $sym, ' . $class_variable . ' }'; + } + + sub inline_slot_access { + my ( $self, $instance, $slot_name ) = @_; + return '*{' . $instance . '}->{' . $slot_name . '}'; + } + + package MyApp::User; + + use Moose; + Moose::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { + instance => ['My::Meta::Instance'], + }, + ); + + has 'name' => ( + is => 'rw', + isa => 'Str', + ); + + has 'email' => ( + is => 'rw', + isa => 'Str', + ); + +=head1 DESCRIPTION + +This recipe shows how to build your own meta-instance. The meta +instance is the metaclass that creates object instances and helps +manages access to attribute slots. + +In this example, we're creating a meta-instance that is based on a +glob reference rather than a hash reference. This example is largely +based on the Piotr Roszatycki's L<MooseX::GlobRef> module. + +Our extension is a role which will be applied to L<Moose::Meta::Instance>, +which creates hash reference based objects. We need to override all the methods +which make assumptions about the object's data structure. + +The first method we override is C<create_instance>: + + sub create_instance { + my $self = shift; + my $sym = gensym(); + bless $sym, $self->_class_name; + } + +This returns an glob reference which has been blessed into our +meta-instance's associated class. + +We also override C<clone_instance> to create a new array reference: + + sub clone_instance { + my ( $self, $instance ) = @_; + + my $new_sym = gensym(); + %{*$new_sym} = %{*$instance}; + + bless $new_sym, $self->_class_name; + } + +After that, we have a series of methods which mediate access to the +object's slots (attributes are stored in "slots"). In the default +instance class, these expect the object to be a hash reference, but we +need to change this to expect a glob reference instead. + + sub get_slot_value { + my ( $self, $instance, $slot_name ) = @_; + *$instance->{$slot_name}; + } + +This level of indirection probably makes our instance class I<slower> +than the default. However, when attribute access is inlined, this +lookup will be cached: + + sub inline_slot_access { + my ( $self, $instance, $slot_name ) = @_; + return '*{' . $instance . '}->{' . $slot_name . '}'; + } + +The code snippet that the C<inline_slot_access> method returns will +get C<eval>'d once per attribute. + +Finally, we use this meta-instance in our C<MyApp::User> class: + + Moose::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { + instance => ['My::Meta::Instance'], + }, + ); + +We actually don't recommend the use of L<Moose::Util::MetaRole> directly in +your class in most cases. Typically, this would be provided by a +L<Moose::Exporter>-based module which handles applying the role for you. + +=head1 CONCLUSION + +This recipe shows how to create your own meta-instance class. It's +unlikely that you'll need to do this yourself, but it's interesting to +take a peek at how Moose works under the hood. + +=head1 SEE ALSO + +There are a few meta-instance class extensions on CPAN: + +=over 4 + +=item * L<MooseX::Singleton> + +This module extends the instance class in order to ensure that the +object is a singleton. The instance it uses is still a blessed hash +reference. + +=item * L<MooseX::GlobRef> + +This module makes the instance a blessed glob reference. This lets you +use a handle as an object instance. + +=back + +=begin testing + +{ + package MyApp::Employee; + + use Moose; + extends 'MyApp::User'; + + has 'employee_number' => ( is => 'rw' ); +} + +for my $x ( 0 .. 1 ) { + MyApp::User->meta->make_immutable if $x; + + my $user = MyApp::User->new( + name => 'Faye', + email => 'faye@example.com', + ); + + ok( eval { *{$user} }, 'user object is an glob ref with some values' ); + + is( $user->name, 'Faye', 'check name' ); + is( $user->email, 'faye@example.com', 'check email' ); + + $user->name('Ralph'); + is( $user->name, 'Ralph', 'check name after changing it' ); + + $user->email('ralph@example.com'); + is( $user->email, 'ralph@example.com', 'check email after changing it' ); +} + +for my $x ( 0 .. 1 ) { + MyApp::Employee->meta->make_immutable if $x; + + my $emp = MyApp::Employee->new( + name => 'Faye', + email => 'faye@example.com', + employee_number => $x, + ); + + ok( eval { *{$emp} }, 'employee object is an glob ref with some values' ); + + is( $emp->name, 'Faye', 'check name' ); + is( $emp->email, 'faye@example.com', 'check email' ); + is( $emp->employee_number, $x, 'check employee_number' ); + + $emp->name('Ralph'); + is( $emp->name, 'Ralph', 'check name after changing it' ); + + $emp->email('ralph@example.com'); + is( $emp->email, 'ralph@example.com', 'check email after changing it' ); + + $emp->employee_number(42); + is( $emp->employee_number, 42, 'check employee_number after changing it' ); +} + +=end testing + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Meta/Labeled_AttributeTrait.pod b/lib/Moose/Cookbook/Meta/Labeled_AttributeTrait.pod new file mode 100644 index 0000000..cebe091 --- /dev/null +++ b/lib/Moose/Cookbook/Meta/Labeled_AttributeTrait.pod @@ -0,0 +1,325 @@ +# PODNAME: Moose::Cookbook::Meta::Labeled_AttributeTrait +# ABSTRACT: Labels implemented via attribute traits + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Cookbook::Meta::Labeled_AttributeTrait - Labels implemented via attribute traits + +=head1 VERSION + +version 2.1405 + +=head1 SYNOPSIS + + package MyApp::Meta::Attribute::Trait::Labeled; + use Moose::Role; + Moose::Util::meta_attribute_alias('Labeled'); + + has label => ( + is => 'rw', + isa => 'Str', + predicate => 'has_label', + ); + + package MyApp::Website; + use Moose; + + has url => ( + traits => [qw/Labeled/], + is => 'rw', + isa => 'Str', + label => "The site's URL", + ); + + has name => ( + is => 'rw', + isa => 'Str', + ); + + sub dump { + my $self = shift; + + my $meta = $self->meta; + + my $dump = ''; + + for my $attribute ( map { $meta->get_attribute($_) } + sort $meta->get_attribute_list ) { + + if ( $attribute->does('MyApp::Meta::Attribute::Trait::Labeled') + && $attribute->has_label ) { + $dump .= $attribute->label; + } + else { + $dump .= $attribute->name; + } + + my $reader = $attribute->get_read_method; + $dump .= ": " . $self->$reader . "\n"; + } + + return $dump; + } + + package main; + + my $app = MyApp::Website->new( url => "http://google.com", name => "Google" ); + +=head1 SUMMARY + +In this recipe, we begin to delve into the wonder of meta-programming. +Some readers may scoff and claim that this is the arena of only the +most twisted Moose developers. Absolutely not! Any sufficiently +twisted developer can benefit greatly from going more meta. + +Our goal is to allow each attribute to have a human-readable "label" +attached to it. Such labels would be used when showing data to an end +user. In this recipe we label the C<url> attribute with "The site's +URL" and create a simple method showing how to use that label. + +=head1 META-ATTRIBUTE OBJECTS + +All the attributes of a Moose-based object are actually objects themselves. +These objects have methods and attributes. Let's look at a concrete example. + + has 'x' => ( isa => 'Int', is => 'ro' ); + has 'y' => ( isa => 'Int', is => 'rw' ); + +Internally, the metaclass for C<Point> has two L<Moose::Meta::Attribute> +objects. There are several methods for getting meta-attributes out of a +metaclass, one of which is C<get_attribute_list>. This method is called on the +metaclass object. + +The C<get_attribute_list> method returns a list of attribute names. You can +then use C<get_attribute> to get the L<Moose::Meta::Attribute> object itself. + +Once you have this meta-attribute object, you can call methods on it like +this: + + print $point->meta->get_attribute('x')->type_constraint; + => Int + +To add a label to our attributes there are two steps. First, we need a new +attribute metaclass trait that can store a label for an attribute. Second, we +need to apply that trait to our attributes. + +=head1 TRAITS + +Roles that apply to metaclasses have a special name: traits. Don't let +the change in nomenclature fool you, B<traits are just roles>. + +L<Moose/has> allows you to pass a C<traits> parameter for an +attribute. This parameter takes a list of trait names which are +composed into an anonymous metaclass, and that anonymous metaclass is +used for the attribute. + +Yes, we still have lots of metaclasses in the background, but they're +managed by Moose for you. + +Traits can do anything roles can do. They can add or refine +attributes, wrap methods, provide more methods, define an interface, +etc. The only difference is that you're now changing the attribute +metaclass instead of a user-level class. + +=head1 DISSECTION + +We start by creating a package for our trait. + + package MyApp::Meta::Attribute::Trait::Labeled; + use Moose::Role; + + has label => ( + is => 'rw', + isa => 'Str', + predicate => 'has_label', + ); + +You can see that a trait is just a L<Moose::Role>. In this case, our role +contains a single attribute, C<label>. Any attribute which does this trait +will now have a label. + +We also register our trait with Moose: + + Moose::Util::meta_attribute_alias('Labeled'); + +This allows Moose to find our trait by the short name C<Labeled> when passed +to the C<traits> attribute option, rather than requiring the full package +name to be specified. + +Finally, we pass our trait when defining an attribute: + + has url => ( + traits => [qw/Labeled/], + is => 'rw', + isa => 'Str', + label => "The site's URL", + ); + +The C<traits> parameter contains a list of trait names. Moose will build an +anonymous attribute metaclass from these traits and use it for this +attribute. + +The reason that we can pass the name C<Labeled>, instead of +C<MyApp::Meta::Attribute::Trait::Labeled>, is because of the +C<register_implementation> code we touched on previously. + +When you pass a metaclass to C<has>, it will take the name you provide and +prefix it with C<Moose::Meta::Attribute::Custom::Trait::>. Then it calls +C<register_implementation> in the package. In this case, that means Moose ends +up calling +C<Moose::Meta::Attribute::Custom::Trait::Labeled::register_implementation>. + +If this function exists, it should return the I<real> trait's package +name. This is exactly what our code does, returning +C<MyApp::Meta::Attribute::Trait::Labeled>. This is a little convoluted, and if +you don't like it, you can always use the fully-qualified name. + +We can access this meta-attribute and its label like this: + + $website->meta->get_attribute('url')->label() + + MyApp::Website->meta->get_attribute('url')->label() + +We also have a regular attribute, C<name>: + + has name => ( + is => 'rw', + isa => 'Str', + ); + +Finally, we have a C<dump> method, which creates a human-readable +representation of a C<MyApp::Website> object. It will use an attribute's label +if it has one. + + sub dump { + my $self = shift; + + my $meta = $self->meta; + + my $dump = ''; + + for my $attribute ( map { $meta->get_attribute($_) } + sort $meta->get_attribute_list ) { + + if ( $attribute->does('MyApp::Meta::Attribute::Trait::Labeled') + && $attribute->has_label ) { + $dump .= $attribute->label; + } + +This is a bit of defensive code. We cannot depend on every meta-attribute +having a label. Even if we define one for every attribute in our class, a +subclass may neglect to do so. Or a superclass could add an attribute without +a label. + +We also check that the attribute has a label using the predicate we +defined. We could instead make the label C<required>. If we have a label, we +use it, otherwise we use the attribute name: + + else { + $dump .= $attribute->name; + } + + my $reader = $attribute->get_read_method; + $dump .= ": " . $self->$reader . "\n"; + } + + return $dump; + } + +The C<get_read_method> is part of the L<Moose::Meta::Attribute> API. It +returns the name of a method that can read the attribute's value, I<when +called on the real object> (don't call this on the meta-attribute). + +=head1 CONCLUSION + +You might wonder why you'd bother with all this. You could just hardcode "The +Site's URL" in the C<dump> method. But we want to avoid repetition. If you +need the label once, you may need it elsewhere, maybe in the C<as_form> method +you write next. + +Associating a label with an attribute just makes sense! The label is a piece +of information I<about> the attribute. + +It's also important to realize that this was a trivial example. You can make +much more powerful metaclasses that I<do> things, as opposed to just storing +some more information. For example, you could implement a metaclass that +expires attributes after a certain amount of time: + + has site_cache => ( + traits => ['TimedExpiry'], + expires_after => { hours => 1 }, + refresh_with => sub { get( $_[0]->url ) }, + isa => 'Str', + is => 'ro', + ); + +The sky's the limit! + +=for testing my $app + = MyApp::Website->new( url => 'http://google.com', name => 'Google' ); +is( + $app->dump, q{name: Google +The site's URL: http://google.com +}, '... got the expected dump value' +); + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Meta/PrivateOrPublic_MethodMetaclass.pod b/lib/Moose/Cookbook/Meta/PrivateOrPublic_MethodMetaclass.pod new file mode 100644 index 0000000..dab0a38 --- /dev/null +++ b/lib/Moose/Cookbook/Meta/PrivateOrPublic_MethodMetaclass.pod @@ -0,0 +1,224 @@ +# PODNAME: Moose::Cookbook::Meta::PrivateOrPublic_MethodMetaclass +# ABSTRACT: A method metaclass for marking methods public or private + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Cookbook::Meta::PrivateOrPublic_MethodMetaclass - A method metaclass for marking methods public or private + +=head1 VERSION + +version 2.1405 + +=head1 SYNOPSIS + + package MyApp::Meta::Method::PrivateOrPublic; + + use Moose; + use Moose::Util::TypeConstraints; + + extends 'Moose::Meta::Method'; + + has '_policy' => ( + is => 'ro', + isa => enum( [ qw( public private ) ] ), + default => 'public', + init_arg => 'policy', + ); + + sub new { + my $class = shift; + my %options = @_; + + my $self = $class->SUPER::wrap(%options); + + $self->{_policy} = $options{policy}; + + $self->_add_policy_wrapper; + + return $self; + } + + sub _add_policy_wrapper { + my $self = shift; + + return if $self->is_public; + + my $name = $self->name; + my $package = $self->package_name; + my $real_body = $self->body; + + my $body = sub { + die "The $package\::$name method is private" + unless ( scalar caller() ) eq $package; + + goto &{$real_body}; + }; + + $self->{body} = $body; + } + + sub is_public { $_[0]->_policy eq 'public' } + sub is_private { $_[0]->_policy eq 'private' } + + package MyApp::User; + + use Moose; + + has 'password' => ( is => 'rw' ); + + __PACKAGE__->meta()->add_method( + '_reset_password', + MyApp::Meta::Method::PrivateOrPublic->new( + name => '_reset_password', + package_name => __PACKAGE__, + body => sub { $_[0]->password('reset') }, + policy => 'private', + ) + ); + +=head1 DESCRIPTION + +This example shows a custom method metaclass that models public versus +private methods. If a method is defined as private, it adds a wrapper +around the method which dies unless it is called from the class where +it was defined. + +The way the method is added to the class is rather ugly. If we wanted +to make this a real feature, we'd probably want to add some sort of +sugar to allow us to declare private methods, but that is beyond the +scope of this recipe. See the Extending recipes for more on this +topic. + +The core of our custom class is the C<policy> attribute, and +C<_add_policy_wrapper> method. + +You'll note that we have to explicitly set the C<policy> attribute in +our constructor: + + $self->{_policy} = $options{policy}; + +That is necessary because Moose metaclasses do not use the meta API to +create objects. Most Moose classes have a custom "inlined" constructor +for speed. + +In this particular case, our parent class's constructor is the C<wrap> +method. We call that to build our object, but it does not include +subclass-specific attributes. + +The C<_add_policy_wrapper> method is where the real work is done. If +the method is private, we construct a wrapper around the real +subroutine which checks that the caller matches the package in which +the subroutine was created. + +If they don't match, it dies. If they do match, the real method is +called. We use C<goto> so that the wrapper does not show up in the +call stack. + +Finally, we replace the value of C<< $self->{body} >>. This is another +case where we have to do something a bit gross because Moose does not +use Moose for its own implementation. + +When we pass this method object to the metaclass's C<add_method> +method, it will take the method body and make it available in the +class. + +Finally, when we retrieve these methods via the introspection API, we +can call the C<is_public> and C<is_private> methods on them to get +more information about the method. + +=head1 SUMMARY + +A custom method metaclass lets us add both behavior and +meta-information to methods. Unfortunately, because the Perl +interpreter does not provide easy hooks into method declaration, the +API we have for adding these methods is not very pretty. + +That can be improved with custom Moose-like sugar, or even by using a +tool like L<Devel::Declare> to create full-blown new keywords in Perl. + +=begin testing + +package main; +use strict; +use warnings; + +use Test::Fatal; + +my $user = MyApp::User->new( password => 'foo!' ); + +like( exception { $user->_reset_password }, +qr/The MyApp::User::_reset_password method is private/, + '_reset_password method dies if called outside MyApp::User class'); + +{ + package MyApp::User; + + sub run_reset { $_[0]->_reset_password } +} + +$user->run_reset; + +is( $user->password, 'reset', 'password has been reset' ); + +=end testing + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Meta/Table_MetaclassTrait.pod b/lib/Moose/Cookbook/Meta/Table_MetaclassTrait.pod new file mode 100644 index 0000000..cf352e7 --- /dev/null +++ b/lib/Moose/Cookbook/Meta/Table_MetaclassTrait.pod @@ -0,0 +1,156 @@ +# PODNAME: Moose::Cookbook::Meta::Table_MetaclassTrait +# ABSTRACT: Adding a "table" attribute as a metaclass trait + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Cookbook::Meta::Table_MetaclassTrait - Adding a "table" attribute as a metaclass trait + +=head1 VERSION + +version 2.1405 + +=head1 SYNOPSIS + + # in lib/MyApp/Meta/Class/Trait/HasTable.pm + package MyApp::Meta::Class::Trait::HasTable; + use Moose::Role; + Moose::Util::meta_class_alias('HasTable'); + + has table => ( + is => 'rw', + isa => 'Str', + ); + + # in lib/MyApp/User.pm + package MyApp::User; + use Moose -traits => 'HasTable'; + + __PACKAGE__->meta->table('User'); + +=head1 DESCRIPTION + +In this recipe, we'll create a class metaclass trait which has a "table" +attribute. This trait is for classes associated with a DBMS table, as one +might do for an ORM. + +In this example, the table name is just a string, but in a real ORM +the table might be an object describing the table. + +=begin testing-SETUP + +BEGIN { + package MyApp::Meta::Class::Trait::HasTable; + use Moose::Role; + Moose::Util::meta_class_alias('HasTable'); + + has table => ( + is => 'rw', + isa => 'Str', + ); +} + +=end testing-SETUP + +=head1 THE METACLASS TRAIT + +This really is as simple as the recipe L</SYNOPSIS> shows. The trick is +getting your classes to use this metaclass, and providing some sort of sugar +for declaring the table. This is covered in +L<Moose::Cookbook::Extending::Debugging_BaseClassRole>, which shows how to +make a module like C<Moose.pm> itself, with sugar like C<has_table()>. + +=head2 Using this Metaclass Trait in Practice + +Accessing this new C<table> attribute is quite simple. Given a class +named C<MyApp::User>, we could simply write the following: + + my $table = MyApp::User->meta->table; + +As long as C<MyApp::User> has arranged to apply the +C<MyApp::Meta::Class::Trait::HasTable> to its metaclass, this method call just +works. If we want to be more careful, we can check that the class metaclass +object has a C<table> method: + + $table = MyApp::User->meta->table + if MyApp::User->meta->can('table'); + +In theory, this is not entirely correct, since the metaclass might be getting +its C<table> method from a I<different> trait. In practice, you are unlikely +to encounter this sort of problem. + +=head1 RECIPE CAVEAT + +This recipe doesn't work when you paste it all into a single file. This is +because the C<< use Moose -traits => 'HasTable'; >> line ends up being +executed before the C<table> attribute is defined. + +When the two packages are separate files, this just works. + +=head1 SEE ALSO + +L<Moose::Cookbook::Meta::Labeled_AttributeTrait> - Labels implemented via +attribute traits + +=for testing can_ok( MyApp::User->meta, 'table' ); +is( MyApp::User->meta->table, 'User', 'My::User table is User' ); + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Meta/WhyMeta.pod b/lib/Moose/Cookbook/Meta/WhyMeta.pod new file mode 100644 index 0000000..9ea83f3 --- /dev/null +++ b/lib/Moose/Cookbook/Meta/WhyMeta.pod @@ -0,0 +1,117 @@ +# PODNAME: Moose::Cookbook::Meta::WhyMeta +# ABSTRACT: Welcome to the meta world (Why Go Meta?) + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Cookbook::Meta::WhyMeta - Welcome to the meta world (Why Go Meta?) + +=head1 VERSION + +version 2.1405 + +=head1 SUMMARY + +You might want to read L<Moose::Manual::MOP> if you haven't done so +yet. + +If you've ever thought "Moose is great, but I wish it did X +differently", then you've gone meta. The meta recipes demonstrate how +to change and extend the way Moose works by extending and overriding +how the meta classes (L<Moose::Meta::Class>, +L<Moose::Meta::Attribute>, etc) work. + +The metaclass API is a set of classes that describe classes, roles, +attributes, etc. The metaclass API lets you ask questions about a +class, like "what attributes does it have?", or "what roles does the +class do?" + +The metaclass system also lets you make changes to a class, for +example by adding new methods or attributes. + +The interface presented by L<Moose.pm|Moose> (C<has>, C<with>, +C<extends>) is just a thin layer of syntactic sugar over the +underlying metaclass system. + +By extending and changing how this metaclass system works, you can +create your own Moose variant. + +=head2 Examples + +Let's say that you want to add additional properties to +attributes. Specifically, we want to add a "label" property to each +attribute, so we can write C<< +My::Class->meta()->get_attribute('size')->label() >>. The first +recipe shows how to do this using an attribute trait. + +You might also want to add additional properties to your +metaclass. For example, if you were writing an ORM based on Moose, you +could associate a table name with each class via the class's metaclass +object, letting you write C<< My::Class->meta()->table_name() >>. + +=head1 SEE ALSO + +Many of the MooseX modules on CPAN implement metaclass extensions. A +couple good examples include L<MooseX::Aliases> and +L<MooseX::UndefTolerant>. For a more complex example see +L<Fey::ORM> or L<Bread::Board::Declare>. + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Roles/ApplicationToInstance.pod b/lib/Moose/Cookbook/Roles/ApplicationToInstance.pod new file mode 100644 index 0000000..8a1d07b --- /dev/null +++ b/lib/Moose/Cookbook/Roles/ApplicationToInstance.pod @@ -0,0 +1,191 @@ +# PODNAME: Moose::Cookbook::Roles::ApplicationToInstance +# ABSTRACT: Applying a role to an object instance + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Cookbook::Roles::ApplicationToInstance - Applying a role to an object instance + +=head1 VERSION + +version 2.1405 + +=head1 SYNOPSIS + + package MyApp::Role::Job::Manager; + + use List::Util qw( first ); + + use Moose::Role; + + has 'employees' => ( + is => 'rw', + isa => 'ArrayRef[Employee]', + ); + + sub assign_work { + my $self = shift; + my $work = shift; + + my $employee = first { !$_->has_work } @{ $self->employees }; + + die 'All my employees have work to do!' unless $employee; + + $employee->work($work); + } + + package main; + + my $lisa = Employee->new( name => 'Lisa' ); + MyApp::Role::Job::Manager->meta->apply($lisa); + + my $homer = Employee->new( name => 'Homer' ); + my $bart = Employee->new( name => 'Bart' ); + my $marge = Employee->new( name => 'Marge' ); + + $lisa->employees( [ $homer, $bart, $marge ] ); + $lisa->assign_work('mow the lawn'); + +=head1 DESCRIPTION + +In this recipe, we show how a role can be applied to an object. In +this specific case, we are giving an employee managerial +responsibilities. + +Applying a role to an object is simple. The L<Moose::Meta::Role> +object provides an C<apply> method. This method will do the right +thing when given an object instance. + + MyApp::Role::Job::Manager->meta->apply($lisa); + +We could also use the C<apply_all_roles> function from L<Moose::Util>. + + apply_all_roles( $person, MyApp::Role::Job::Manager->meta ); + +The main advantage of using C<apply_all_roles> is that it can be used +to apply more than one role at a time. + +We could also pass parameters to the role we're applying: + + MyApp::Role::Job::Manager->meta->apply( + $lisa, + -alias => { assign_work => 'get_off_your_lazy_behind' }, + ); + +We saw examples of how method exclusion and alias working in +L<Moose::Cookbook::Roles::Restartable_AdvancedComposition>. + +=begin testing-SETUP + +{ + # Not in the recipe, but needed for writing tests. + package Employee; + + use Moose; + + has 'name' => ( + is => 'ro', + isa => 'Str', + required => 1, + ); + + has 'work' => ( + is => 'rw', + isa => 'Str', + predicate => 'has_work', + ); +} + +=end testing-SETUP + +=head1 CONCLUSION + +Applying a role to an object instance is a useful tool for adding +behavior to existing objects. In our example, it is effective used to +model a promotion. + +It can also be useful as a sort of controlled monkey-patching for +existing code, particularly non-Moose code. For example, you could +create a debugging role and apply it to an object at runtime. + +=begin testing + +{ + my $lisa = Employee->new( name => 'Lisa' ); + MyApp::Role::Job::Manager->meta->apply($lisa); + + my $homer = Employee->new( name => 'Homer' ); + my $bart = Employee->new( name => 'Bart' ); + my $marge = Employee->new( name => 'Marge' ); + + $lisa->employees( [ $homer, $bart, $marge ] ); + $lisa->assign_work('mow the lawn'); + + ok( $lisa->does('MyApp::Role::Job::Manager'), + 'lisa now does the manager role' ); + + is( $homer->work, 'mow the lawn', + 'homer was assigned a task by lisa' ); +} + +=end testing + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Roles/Comparable_CodeReuse.pod b/lib/Moose/Cookbook/Roles/Comparable_CodeReuse.pod new file mode 100644 index 0000000..2c59dcf --- /dev/null +++ b/lib/Moose/Cookbook/Roles/Comparable_CodeReuse.pod @@ -0,0 +1,379 @@ +# PODNAME: Moose::Cookbook::Roles::Comparable_CodeReuse +# ABSTRACT: Using roles for code reuse + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Cookbook::Roles::Comparable_CodeReuse - Using roles for code reuse + +=head1 VERSION + +version 2.1405 + +=head1 SYNOPSIS + + package Eq; + use Moose::Role; + + requires 'equal_to'; + + sub not_equal_to { + my ( $self, $other ) = @_; + not $self->equal_to($other); + } + + package Comparable; + use Moose::Role; + + with 'Eq'; + + requires 'compare'; + + sub equal_to { + my ( $self, $other ) = @_; + $self->compare($other) == 0; + } + + sub greater_than { + my ( $self, $other ) = @_; + $self->compare($other) == 1; + } + + sub less_than { + my ( $self, $other ) = @_; + $self->compare($other) == -1; + } + + sub greater_than_or_equal_to { + my ( $self, $other ) = @_; + $self->greater_than($other) || $self->equal_to($other); + } + + sub less_than_or_equal_to { + my ( $self, $other ) = @_; + $self->less_than($other) || $self->equal_to($other); + } + + package Printable; + use Moose::Role; + + requires 'to_string'; + + package US::Currency; + use Moose; + + with 'Comparable', 'Printable'; + + has 'amount' => ( is => 'rw', isa => 'Num', default => 0 ); + + sub compare { + my ( $self, $other ) = @_; + $self->amount <=> $other->amount; + } + + sub to_string { + my $self = shift; + sprintf '$%0.2f USD' => $self->amount; + } + +=head1 DESCRIPTION + +Roles have two primary purposes: as interfaces, and as a means of code +reuse. This recipe demonstrates the latter, with roles that define +comparison and display code for objects. + +Let's start with C<Eq>. First, note that we've replaced C<use Moose> +with C<use Moose::Role>. We also have a new sugar function, C<requires>: + + requires 'equal_to'; + +This says that any class which consumes this role must provide an +C<equal_to> method. It can provide this method directly, or by +consuming some other role. + +The C<Eq> role defines its C<not_equal_to> method in terms of the +required C<equal_to> method. This lets us minimize the methods that +consuming classes must provide. + +The next role, C<Comparable>, builds on the C<Eq> role. We include +C<Eq> in C<Comparable> using C<with>, another new sugar function: + + with 'Eq'; + +The C<with> function takes a list of roles to consume. In our example, +the C<Comparable> role provides the C<equal_to> method required by +C<Eq>. However, it could opt not to, in which case a class that +consumed C<Comparable> would have to provide its own C<equal_to>. In +other words, a role can consume another role I<without> providing any +required methods. + +The C<Comparable> role requires a method, C<compare>: + + requires 'compare'; + +The C<Comparable> role also provides a number of other methods, all of +which ultimately rely on C<compare>. + + sub equal_to { + my ( $self, $other ) = @_; + $self->compare($other) == 0; + } + + sub greater_than { + my ( $self, $other ) = @_; + $self->compare($other) == 1; + } + + sub less_than { + my ( $self, $other ) = @_; + $self->compare($other) == -1; + } + + sub greater_than_or_equal_to { + my ( $self, $other ) = @_; + $self->greater_than($other) || $self->equal_to($other); + } + + sub less_than_or_equal_to { + my ( $self, $other ) = @_; + $self->less_than($other) || $self->equal_to($other); + } + +Finally, we define the C<Printable> role. This role exists solely to +provide an interface. It has no methods, just a list of required methods. +In this case, it just requires a C<to_string> method. + +An interface role is useful because it defines both a method and a +I<name>. We know that any class which does this role has a +C<to_string> method, but we can also assume that this method has the +semantics we want. Presumably, in real code we would define those +semantics in the documentation for the C<Printable> role. (1) + +Finally, we have the C<US::Currency> class which consumes both the +C<Comparable> and C<Printable> roles. + + with 'Comparable', 'Printable'; + +It also defines a regular Moose attribute, C<amount>: + + has 'amount' => ( is => 'rw', isa => 'Num', default => 0 ); + +Finally we see the implementation of the methods required by our +roles. We have a C<compare> method: + + sub compare { + my ( $self, $other ) = @_; + $self->amount <=> $other->amount; + } + +By consuming the C<Comparable> role and defining this method, we gain +the following methods for free: C<equal_to>, C<greater_than>, +C<less_than>, C<greater_than_or_equal_to> and +C<less_than_or_equal_to>. + +Then we have our C<to_string> method: + + sub to_string { + my $self = shift; + sprintf '$%0.2f USD' => $self->amount; + } + +=head1 CONCLUSION + +Roles can be very powerful. They are a great way of encapsulating +reusable behavior, as well as communicating (semantic and interface) +information about the methods our classes provide. + +=head1 FOOTNOTES + +=over 4 + +=item (1) + +Consider two classes, C<Runner> and C<Process>, both of which define a +C<run> method. If we just require that an object implements a C<run> +method, we still aren't saying anything about what that method +I<actually does>. If we require an object that implements the +C<Executable> role, we're saying something about semantics. + +=back + +=begin testing + +ok( US::Currency->does('Comparable'), '... US::Currency does Comparable' ); +ok( US::Currency->does('Eq'), '... US::Currency does Eq' ); +ok( US::Currency->does('Printable'), '... US::Currency does Printable' ); + +my $hundred = US::Currency->new( amount => 100.00 ); +isa_ok( $hundred, 'US::Currency' ); + +ok( $hundred->DOES("US::Currency"), "UNIVERSAL::DOES for class" ); +ok( $hundred->DOES("Comparable"), "UNIVERSAL::DOES for role" ); + +can_ok( $hundred, 'amount' ); +is( $hundred->amount, 100, '... got the right amount' ); + +can_ok( $hundred, 'to_string' ); +is( $hundred->to_string, '$100.00 USD', + '... got the right stringified value' ); + +ok( $hundred->does('Comparable'), '... US::Currency does Comparable' ); +ok( $hundred->does('Eq'), '... US::Currency does Eq' ); +ok( $hundred->does('Printable'), '... US::Currency does Printable' ); + +my $fifty = US::Currency->new( amount => 50.00 ); +isa_ok( $fifty, 'US::Currency' ); + +can_ok( $fifty, 'amount' ); +is( $fifty->amount, 50, '... got the right amount' ); + +can_ok( $fifty, 'to_string' ); +is( $fifty->to_string, '$50.00 USD', '... got the right stringified value' ); + +ok( $hundred->greater_than($fifty), '... 100 gt 50' ); +ok( $hundred->greater_than_or_equal_to($fifty), '... 100 ge 50' ); +ok( !$hundred->less_than($fifty), '... !100 lt 50' ); +ok( !$hundred->less_than_or_equal_to($fifty), '... !100 le 50' ); +ok( !$hundred->equal_to($fifty), '... !100 eq 50' ); +ok( $hundred->not_equal_to($fifty), '... 100 ne 50' ); + +ok( !$fifty->greater_than($hundred), '... !50 gt 100' ); +ok( !$fifty->greater_than_or_equal_to($hundred), '... !50 ge 100' ); +ok( $fifty->less_than($hundred), '... 50 lt 100' ); +ok( $fifty->less_than_or_equal_to($hundred), '... 50 le 100' ); +ok( !$fifty->equal_to($hundred), '... !50 eq 100' ); +ok( $fifty->not_equal_to($hundred), '... 50 ne 100' ); + +ok( !$fifty->greater_than($fifty), '... !50 gt 50' ); +ok( $fifty->greater_than_or_equal_to($fifty), '... !50 ge 50' ); +ok( !$fifty->less_than($fifty), '... 50 lt 50' ); +ok( $fifty->less_than_or_equal_to($fifty), '... 50 le 50' ); +ok( $fifty->equal_to($fifty), '... 50 eq 50' ); +ok( !$fifty->not_equal_to($fifty), '... !50 ne 50' ); + +## ... check some meta-stuff + +# Eq + +my $eq_meta = Eq->meta; +isa_ok( $eq_meta, 'Moose::Meta::Role' ); + +ok( $eq_meta->has_method('not_equal_to'), '... Eq has_method not_equal_to' ); +ok( $eq_meta->requires_method('equal_to'), + '... Eq requires_method not_equal_to' ); + +# Comparable + +my $comparable_meta = Comparable->meta; +isa_ok( $comparable_meta, 'Moose::Meta::Role' ); + +ok( $comparable_meta->does_role('Eq'), '... Comparable does Eq' ); + +foreach my $method_name ( + qw( + equal_to not_equal_to + greater_than greater_than_or_equal_to + less_than less_than_or_equal_to + ) + ) { + ok( $comparable_meta->has_method($method_name), + '... Comparable has_method ' . $method_name ); +} + +ok( $comparable_meta->requires_method('compare'), + '... Comparable requires_method compare' ); + +# Printable + +my $printable_meta = Printable->meta; +isa_ok( $printable_meta, 'Moose::Meta::Role' ); + +ok( $printable_meta->requires_method('to_string'), + '... Printable requires_method to_string' ); + +# US::Currency + +my $currency_meta = US::Currency->meta; +isa_ok( $currency_meta, 'Moose::Meta::Class' ); + +ok( $currency_meta->does_role('Comparable'), + '... US::Currency does Comparable' ); +ok( $currency_meta->does_role('Eq'), '... US::Currency does Eq' ); +ok( $currency_meta->does_role('Printable'), + '... US::Currency does Printable' ); + +foreach my $method_name ( + qw( + amount + equal_to not_equal_to + compare + greater_than greater_than_or_equal_to + less_than less_than_or_equal_to + to_string + ) + ) { + ok( $currency_meta->has_method($method_name), + '... US::Currency has_method ' . $method_name ); +} + +=end testing + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Roles/Restartable_AdvancedComposition.pod b/lib/Moose/Cookbook/Roles/Restartable_AdvancedComposition.pod new file mode 100644 index 0000000..53069a2 --- /dev/null +++ b/lib/Moose/Cookbook/Roles/Restartable_AdvancedComposition.pod @@ -0,0 +1,230 @@ +# PODNAME: Moose::Cookbook::Roles::Restartable_AdvancedComposition +# ABSTRACT: Advanced Role Composition - method exclusion and aliasing + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Cookbook::Roles::Restartable_AdvancedComposition - Advanced Role Composition - method exclusion and aliasing + +=head1 VERSION + +version 2.1405 + +=head1 SYNOPSIS + + package Restartable; + use Moose::Role; + + has 'is_paused' => ( + is => 'rw', + isa => 'Bool', + default => 0, + ); + + requires 'save_state', 'load_state'; + + sub stop { 1 } + + sub start { 1 } + + package Restartable::ButUnreliable; + use Moose::Role; + + with 'Restartable' => { + -alias => { + stop => '_stop', + start => '_start' + }, + -excludes => [ 'stop', 'start' ], + }; + + sub stop { + my $self = shift; + + $self->explode() if rand(1) > .5; + + $self->_stop(); + } + + sub start { + my $self = shift; + + $self->explode() if rand(1) > .5; + + $self->_start(); + } + + package Restartable::ButBroken; + use Moose::Role; + + with 'Restartable' => { -excludes => [ 'stop', 'start' ] }; + + sub stop { + my $self = shift; + + $self->explode(); + } + + sub start { + my $self = shift; + + $self->explode(); + } + +=head1 DESCRIPTION + +In this example, we demonstrate how to exercise fine-grained control +over what methods we consume from a role. We have a C<Restartable> +role which provides an C<is_paused> attribute, and two methods, +C<stop> and C<start>. + +Then we have two more roles which implement the same interface, each +putting their own spin on the C<stop> and C<start> methods. + +In the C<Restartable::ButUnreliable> role, we want to provide a new +implementation of C<stop> and C<start>, but still have access to the +original implementation. To do this, we alias the methods from +C<Restartable> to private methods, and provide wrappers around the +originals (1). + +Note that aliasing simply I<adds> a name, so we also need to exclude the +methods with their original names. + + with 'Restartable' => { + -alias => { + stop => '_stop', + start => '_start' + }, + -excludes => [ 'stop', 'start' ], + }; + +In the C<Restartable::ButBroken> role, we want to provide an entirely +new behavior for C<stop> and C<start>. We exclude them entirely when +composing the C<Restartable> role into C<Restartable::ButBroken>. + +It's worth noting that the C<-excludes> parameter also accepts a single +string as an argument if you just want to exclude one method. + + with 'Restartable' => { -excludes => [ 'stop', 'start' ] }; + +=head1 CONCLUSION + +Exclusion and renaming are a power tool that can be handy, especially +when building roles out of other roles. In this example, all of our +roles implement the C<Restartable> role. Each role provides same API, +but each has a different implementation under the hood. + +You can also use the method aliasing and excluding features when +composing a role into a class. + +=head1 FOOTNOTES + +=over 4 + +=item (1) + +The mention of wrapper should tell you that we could do the same thing +using method modifiers, but for the sake of this example, we don't. + +=back + +=begin testing + +{ + my $unreliable = Moose::Meta::Class->create_anon_class( + superclasses => [], + roles => [qw/Restartable::ButUnreliable/], + methods => { + explode => sub { }, # nop. + 'save_state' => sub { }, + 'load_state' => sub { }, + }, + )->new_object(); + ok( $unreliable, 'made anon class with Restartable::ButUnreliable role' ); + can_ok( $unreliable, qw/start stop/ ); +} + +{ + my $cnt = 0; + my $broken = Moose::Meta::Class->create_anon_class( + superclasses => [], + roles => [qw/Restartable::ButBroken/], + methods => { + explode => sub { $cnt++ }, + 'save_state' => sub { }, + 'load_state' => sub { }, + }, + )->new_object(); + + ok( $broken, 'made anon class with Restartable::ButBroken role' ); + + $broken->start(); + + is( $cnt, 1, '... start called explode' ); + + $broken->stop(); + + is( $cnt, 2, '... stop also called explode' ); +} + +=end testing + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Snack/Keywords.pod b/lib/Moose/Cookbook/Snack/Keywords.pod new file mode 100644 index 0000000..a79cc57 --- /dev/null +++ b/lib/Moose/Cookbook/Snack/Keywords.pod @@ -0,0 +1,240 @@ +# PODNAME: Moose::Cookbook::Snack::Keywords +# ABSTRACT: Restricted "keywords" in Moose + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Cookbook::Snack::Keywords - Restricted "keywords" in Moose + +=head1 VERSION + +version 2.1405 + +=head1 DESCRIPTION + +Moose exports a number of sugar functions in order to emulate Perl +built-in keywords. These can cause clashes with other user-defined +functions. This document provides a list of those keywords for easy +reference. + +=head2 The 'meta' keyword + +C<S<use Moose>> adds a method called C<meta> to your class. If this +conflicts with a method or function you are using, you can rename it, +or prevent it from being installed entirely. To do this, pass the +C<-meta_name> option when you C<S<use Moose>>. For instance: + + # install it under a different name + use Moose -meta_name => 'moose_meta'; + + # don't install it at all + use Moose -meta_name => undef; + +=head2 Moose Keywords + +If you are using L<Moose> or L<Moose::Role> it is best to avoid these +keywords: + +=over 4 + +=item extends + +=item with + +=item has + +=item before + +=item after + +=item around + +=item super + +=item override + +=item inner + +=item augment + +=item confess + +=item blessed + +=item meta + +=back + +=head2 Moose::Util::TypeConstraints Keywords + +If you are using L<Moose::Util::TypeConstraints> it is best to avoid +these keywords: + +=over 4 + +=item type + +=item subtype + +=item class_type + +=item role_type + +=item maybe_type + +=item duck_type + +=item as + +=item where + +=item message + +=item inline_as + +=item coerce + +=item from + +=item via + +=item enum + +=item find_type_constraint + +=item register_type_constraint + +=back + +=head2 Avoiding collisions + +=head3 Turning off Moose + +To remove the sugar functions L<Moose> exports, just add C<S<no Moose>> +at the bottom of your code: + + package Thing; + use Moose; + + # code here + + no Moose; + +This will unexport the sugar functions that L<Moose> originally +exported. The same will also work for L<Moose::Role> and +L<Moose::Util::TypeConstraints>. + +=head3 Sub::Exporter features + +L<Moose>, L<Moose::Role> and L<Moose::Util::TypeConstraints> all use +L<Sub::Exporter> to handle all their exporting needs. This means that +all the features that L<Sub::Exporter> provides are also available to +them. + +For instance, with L<Sub::Exporter> you can rename keywords, like so: + + package LOL::Cat; + use Moose 'has' => { -as => 'i_can_haz' }; + + i_can_haz 'cheeseburger' => ( + is => 'rw', + trigger => sub { print "NOM NOM" } + ); + + LOL::Cat->new->cheeseburger('KTHNXBYE'); + +See the L<Sub::Exporter> docs for more information. + +=head3 namespace::autoclean and namespace::clean + +You can also use L<namespace::autoclean> to clean up your namespace. +This will remove all imported functions from your namespace. Note +that if you are importing functions that are intended to be used as +methods (this includes L<overload>, due to internal implementation +details), it will remove these as well. + +Another option is to use L<namespace::clean> directly, but +you must be careful not to remove C<meta> when doing so: + + package Foo; + use Moose; + use namespace::clean -except => 'meta'; + # ... + +=head1 SEE ALSO + +=over 4 + +=item L<Moose> + +=item L<Moose::Role> + +=item L<Moose::Util::TypeConstraints> + +=item L<Sub::Exporter> + +=item L<namespace::autoclean> + +=item L<namespace::clean> + +=back + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Snack/Types.pod b/lib/Moose/Cookbook/Snack/Types.pod new file mode 100644 index 0000000..44f9b5b --- /dev/null +++ b/lib/Moose/Cookbook/Snack/Types.pod @@ -0,0 +1,130 @@ +# PODNAME: Moose::Cookbook::Snack::Types +# ABSTRACT: Snippets of code for using Types and Type Constraints + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Cookbook::Snack::Types - Snippets of code for using Types and Type Constraints + +=head1 VERSION + +version 2.1405 + +=head1 SYNOPSIS + + package Point; + use Moose; + + has 'x' => ( isa => 'Int', is => 'ro' ); + has 'y' => ( isa => 'Int', is => 'rw' ); + + package main; + use Try::Tiny; + + my $point = try { + Point->new( x => 'fifty', y => 'forty' ); + } + catch { + print "Oops: $_"; + }; + + my $point; + my $xval = 'forty-two'; + my $xattribute = Point->meta->find_attribute_by_name('x'); + my $xtype_constraint = $xattribute->type_constraint; + + if ( $xtype_constraint->check($xval) ) { + $point = Point->new( x => $xval, y => 0 ); + } + else { + print "Value: $xval is not an " . $xtype_constraint->name . "\n"; + } + +=head1 DESCRIPTION + +This is the Point example from +L<Moose::Cookbook::Basics::Point_AttributesAndSubclassing> with type checking +added. + +If we try to assign a string value to an attribute that is an C<Int>, +Moose will die with an explicit error message. The error will include +the attribute name, as well as the type constraint name and the value +which failed the constraint check. + +We use L<Try::Tiny> to catch this error message. + +Later, we get the L<Moose::Meta::TypeConstraint> object from a +L<Moose::Meta::Attribute> and use the L<Moose::Meta::TypeConstraint> +to check a value directly. + +=head1 SEE ALSO + +=over 4 + +=item L<Moose::Cookbook::Basics::Point_AttributesAndSubclassing> + +=item L<Moose::Util::TypeConstraints> + +=item L<Moose::Meta::Attribute> + +=back + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 diff --git a/lib/Moose/Cookbook/Style.pod b/lib/Moose/Cookbook/Style.pod new file mode 100644 index 0000000..be9334b --- /dev/null +++ b/lib/Moose/Cookbook/Style.pod @@ -0,0 +1,77 @@ +# PODNAME: Moose::Cookbook::Style +# ABSTRACT: Expanded into Moose::Manual::BestPractices, so go read that + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Cookbook::Style - Expanded into Moose::Manual::BestPractices, so go read that + +=head1 VERSION + +version 2.1405 + +=head1 DESCRIPTION + +The style cookbook has been replaced by +L<Moose::Manual::BestPractices>. This POD document still exists for +the benefit of anyone out there who might've linked to it in the past. + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=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 |