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

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

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

1268
CPAN/Moose.pm Normal file
View File

File diff suppressed because it is too large Load Diff

132
CPAN/Moose/Conflicts.pm Normal file
View File

@@ -0,0 +1,132 @@
package # hide from PAUSE
Moose::Conflicts;
use strict;
use warnings;
# this module was generated with Dist::Zilla::Plugin::Conflicts 0.20
use Dist::CheckConflicts
-dist => 'Moose',
-conflicts => {
'Catalyst' => '5.90049999',
'Config::MVP' => '2.200004',
'Devel::REPL' => '1.003020',
'Dist::Zilla' => '5.043',
'Dist::Zilla::Plugin::Git' => '2.016',
'Fey' => '0.36',
'Fey::ORM' => '0.42',
'File::ChangeNotify' => '0.15',
'HTTP::Throwable' => '0.017',
'KiokuDB' => '0.51',
'Markdent' => '0.16',
'Mason' => '2.18',
'Moose::Autobox' => '0.15',
'MooseX::ABC' => '0.05',
'MooseX::Aliases' => '0.08',
'MooseX::AlwaysCoerce' => '0.13',
'MooseX::App' => '1.22',
'MooseX::Attribute::Deflator' => '2.1.7',
'MooseX::Attribute::Dependent' => '1.1.3',
'MooseX::Attribute::Prototype' => '0.10',
'MooseX::AttributeHelpers' => '0.22',
'MooseX::AttributeIndexes' => '1.0.0',
'MooseX::AttributeInflate' => '0.02',
'MooseX::CascadeClearing' => '0.03',
'MooseX::ClassAttribute' => '0.26',
'MooseX::Constructor::AllErrors' => '0.021',
'MooseX::Declare' => '0.35',
'MooseX::FollowPBP' => '0.02',
'MooseX::Getopt' => '0.56',
'MooseX::InstanceTracking' => '0.04',
'MooseX::LazyRequire' => '0.06',
'MooseX::Meta::Attribute::Index' => '0.04',
'MooseX::Meta::Attribute::Lvalue' => '0.05',
'MooseX::Method::Signatures' => '0.44',
'MooseX::MethodAttributes' => '0.22',
'MooseX::NonMoose' => '0.24',
'MooseX::Object::Pluggable' => '0.0011',
'MooseX::POE' => '0.214',
'MooseX::Params::Validate' => '0.05',
'MooseX::PrivateSetters' => '0.03',
'MooseX::Role::Cmd' => '0.06',
'MooseX::Role::Parameterized' => '1.00',
'MooseX::Role::WithOverloading' => '0.14',
'MooseX::Runnable' => '0.03',
'MooseX::Scaffold' => '0.05',
'MooseX::SemiAffordanceAccessor' => '0.05',
'MooseX::SetOnce' => '0.100473',
'MooseX::Singleton' => '0.25',
'MooseX::SlurpyConstructor' => '1.1',
'MooseX::Storage' => '0.42',
'MooseX::StrictConstructor' => '0.12',
'MooseX::Traits' => '0.11',
'MooseX::Types' => '0.19',
'MooseX::Types::Parameterizable' => '0.05',
'MooseX::Types::Set::Object' => '0.03',
'MooseX::Types::Signal' => '1.101930',
'MooseX::UndefTolerant' => '0.11',
'Net::Twitter' => '4.01041',
'PRANG' => '0.14',
'Pod::Elemental' => '0.093280',
'Pod::Weaver' => '3.101638',
'Reaction' => '0.002003',
'Test::Able' => '0.10',
'Test::CleanNamespaces' => '0.03',
'Test::Moose::More' => '0.022',
'Test::TempDir' => '0.05',
'Throwable' => '0.102080',
'namespace::autoclean' => '0.08',
},
-also => [ qw(
Carp
Class::Load
Class::Load::XS
Data::OptList
Devel::GlobalDestruction
Devel::OverloadInfo
Devel::StackTrace
Dist::CheckConflicts
Eval::Closure
List::Util
MRO::Compat
Module::Runtime
Module::Runtime::Conflicts
Package::DeprecationManager
Package::Stash
Package::Stash::XS
Params::Util
Scalar::Util
Sub::Exporter
Sub::Util
Try::Tiny
parent
strict
warnings
) ],
;
1;
# ABSTRACT: Check for conflicts between Moose and installed packages
# Dist::Zilla: -PodWeaver
__END__
=pod
=for Pod::Coverage *EVERYTHING*
=head1 NAME
Moose::Conflicts - Check for conflicts between Moose and installed packages
=head1 DESCRIPTION
This module contains information about conflicts between this distribution and
other CPAN distributions. It does not have any user-facing parts.
This module was generated by Dist::Zilla::Plugin::Conflicts 0.20.
=cut

289
CPAN/Moose/Cookbook.pod Normal file
View File

@@ -0,0 +1,289 @@
# PODNAME: Moose::Cookbook
# ABSTRACT: How to cook a Moose
__END__
=pod
=encoding UTF-8
=head1 NAME
Moose::Cookbook - How to cook a Moose
=head1 VERSION
version 2.2207
=head1 DESCRIPTION
The Moose cookbook is a series of recipes showing various Moose
features. Most recipes present some code demonstrating some feature,
and then explain the details of the code.
You should probably read the L<Moose::Manual> first. The manual
explains Moose concepts without being too code-heavy.
=head1 RECIPES
=head2 Basic Moose
These recipes will give you a good overview of Moose's capabilities, starting
with simple attribute declaration, and moving on to more powerful features like
laziness, types, type coercion, method modifiers, and more.
=over 4
=item L<Moose::Cookbook::Basics::Point_AttributesAndSubclassing>
A simple Moose-based class. Demonstrates basic Moose attributes and subclassing.
=item L<Moose::Cookbook::Basics::BankAccount_MethodModifiersAndSubclassing>
A slightly more complex Moose class. Demonstrates using a method modifier in a
subclass.
=item L<Moose::Cookbook::Basics::BinaryTree_AttributeFeatures>
Demonstrates several attribute features, including types, weak
references, predicates ("does this object have a foo?"), defaults,
laziness, and triggers.
=item L<Moose::Cookbook::Basics::Company_Subtypes>
Introduces the creation and use of custom types, a C<BUILD> method, and the
use of C<override> in a subclass. This recipe also shows how to model a set of
classes that could be used to model companies, people, employees, etc.
=item L<Moose::Cookbook::Basics::HTTP_SubtypesAndCoercion>
This recipe covers more subtype creation, including the use of type coercions.
=item L<Moose::Cookbook::Basics::Immutable>
Making a class immutable greatly increases the speed of accessors and
object construction.
=item L<Moose::Cookbook::Basics::BinaryTree_BuilderAndLazyBuild> - Builder methods and lazy_build
The builder feature provides an inheritable and role-composable way to
provide a default attribute value.
=item L<Moose::Cookbook::Basics::Genome_OverloadingSubtypesAndCoercion>
Demonstrates using operator overloading, coercion, and subtypes to
model how eye color is determined during reproduction.
=item L<Moose::Cookbook::Basics::Person_BUILDARGSAndBUILD>
This recipe demonstrates the use of C<BUILDARGS> and C<BUILD> to hook
into object construction.
=item L<Moose::Cookbook::Basics::DateTime_ExtendingNonMooseParent>
In this recipe, we make a Moose-based subclass of L<DateTime>, a
module which does not use Moose itself.
=item L<Moose::Cookbook::Basics::Document_AugmentAndInner>
Demonstrates the use of C<augment> method modifiers, a way of turning
the usual method overriding style "inside-out".
=back
=head2 Moose Roles
These recipes will show you how to use Moose roles.
=over 4
=item L<Moose::Cookbook::Roles::Comparable_CodeReuse>
Demonstrates roles, which are also sometimes known as traits or
mix-ins. Roles provide a method of code re-use which is orthogonal to
subclassing.
=item L<Moose::Cookbook::Roles::Restartable_AdvancedComposition>
Sometimes you just want to include part of a role in your
class. Sometimes you want the whole role but one of its methods
conflicts with one in your class. With method exclusion and aliasing,
you can work around these problems.
=item L<Moose::Cookbook::Roles::ApplicationToInstance>
In this recipe, we apply a role to an existing object instance.
=back
=head2 Meta Moose
These recipes show you how to write your own meta classes, which lets
you extend the object system provided by Moose.
=over 4
=item L<Moose::Cookbook::Meta::WhyMeta>
If you're wondering what all this "meta" stuff is, and why you should
care about it, read this "recipe".
=item L<Moose::Cookbook::Meta::Labeled_AttributeTrait>
Extending Moose's attribute metaclass is a great way to add
functionality. However, attributes can only have one metaclass.
Applying roles to the attribute metaclass lets you provide
composable attribute functionality.
=item L<Moose::Cookbook::Meta::Table_MetaclassTrait>
This recipe takes the class metaclass we saw in the previous recipe
and reimplements it as a metaclass trait.
=item L<Moose::Cookbook::Meta::PrivateOrPublic_MethodMetaclass>
This recipe shows a custom method metaclass that implements making a
method private.
=item L<Moose::Cookbook::Meta::GlobRef_InstanceMetaclass>
This recipe shows an example of how you create your own meta-instance
class. The meta-instance determines the internal structure of object
instances and provide access to attribute slots.
In this particular instance, we use a blessed glob reference as the instance
instead of a blessed hash reference.
=item Hooking into immutabilization (TODO)
Moose has a feature known as "immutabilization". By calling C<<
__PACKAGE__->meta()->make_immutable() >> after defining your class
(attributes, roles, etc), you tell Moose to optimize things like
object creation, attribute access, and so on.
If you are creating your own metaclasses, you may need to hook into
the immutabilization system. This cuts across a number of spots,
including the metaclass class, meta method classes, and possibly the
meta-instance class as well.
This recipe shows you how to write extensions which immutabilize
properly.
=back
=head2 Extending Moose
These recipes cover some more ways to extend Moose, and will be useful
if you plan to write your own C<MooseX> module.
=over 4
=item L<Moose::Cookbook::Extending::ExtensionOverview>
There are quite a few ways to extend Moose. This recipe provides an
overview of each method, and provides recommendations for when each is
appropriate.
=item L<Moose::Cookbook::Extending::Debugging_BaseClassRole>
Many base object class extensions can be implemented as roles. This
example shows how to provide a base object class debugging role that
is applied to any class that uses a notional C<MooseX::Debugging>
module.
=item L<Moose::Cookbook::Extending::Mooseish_MooseSugar>
This recipe shows how to provide a replacement for C<Moose.pm>. You
may want to do this as part of the API for a C<MooseX> module,
especially if you want to default to a new metaclass class or base
object class.
=back
=head1 SNACKS
=over 4
=item L<Moose::Cookbook::Snack::Keywords>
=item L<Moose::Cookbook::Snack::Types>
=back
=head1 Legacy Recipes
These cover topics that are no longer considered best practice. We've kept
them in case in you encounter these usages in the wild.
=over 4
=item L<Moose::Cookbook::Legacy::Labeled_AttributeMetaclass>
=item L<Moose::Cookbook::Legacy::Table_ClassMetaclass>
=item L<Moose::Cookbook::Legacy::Debugging_BaseClassReplacement>
=back
=head1 SEE ALSO
=over 4
=item L<http://www.gsph.com/index.php?Lang=En&ID=291>
=back
=head1 AUTHORS
=over 4
=item *
Stevan Little <stevan@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This 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

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

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

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

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

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

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

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

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

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

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

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

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

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

@@ -0,0 +1,318 @@
# PODNAME: Moose::Cookbook::Basics::Genome_OverloadingSubtypesAndCoercion
# ABSTRACT: Operator overloading, subtypes, and coercion
__END__
=pod
=encoding UTF-8
=head1 NAME
Moose::Cookbook::Basics::Genome_OverloadingSubtypesAndCoercion - Operator overloading, subtypes, and coercion
=head1 VERSION
version 2.2207
=head1 SYNOPSIS
package Human;
use Moose;
use Moose::Util::TypeConstraints;
subtype 'Sex'
=> as 'Str'
=> where { $_ =~ m{^[mf]$}s };
has 'sex' => ( is => 'ro', isa => 'Sex', required => 1 );
has 'mother' => ( is => 'ro', isa => 'Human' );
has 'father' => ( is => 'ro', isa => 'Human' );
use overload '+' => \&_overload_add, fallback => 1;
sub _overload_add {
my ( $one, $two ) = @_;
die('Only male and female humans may create children')
if ( $one->sex() eq $two->sex() );
my ( $mother, $father )
= ( $one->sex eq 'f' ? ( $one, $two ) : ( $two, $one ) );
my $sex = 'f';
$sex = 'm' if ( rand() >= 0.5 );
return Human->new(
sex => $sex,
mother => $mother,
father => $father,
);
}
=head1 DESCRIPTION
This Moose cookbook recipe shows how operator overloading, coercion,
and subtypes can be used to mimic the human reproductive system
(well, the selection of genes at least).
=head1 INTRODUCTION
Our C<Human> class uses operator overloading to allow us to "add" two
humans together and produce a child. Our implementation does require
that the two objects be of opposite sex. Remember, we're talking
about biological reproduction, not marriage.
While this example works as-is, we can take it a lot further by adding
genes into the mix. We'll add the two genes that control eye color,
and use overloading to combine the genes from the parent to model the
biology.
=head2 What is Operator Overloading?
Overloading is I<not> a Moose-specific feature. It's a general OO
concept that is implemented in Perl with the C<overload>
pragma. Overloading lets objects do something sane when used with
Perl's built in operators, like addition (C<+>) or when used as a
string.
In this example we overload addition so we can write code like
C<$child = $mother + $father>.
=head1 GENES
There are many genes which affect eye color, but there are two which
are most important, I<gey> and I<bey2>. We will start by making a
class for each gene.
=head2 Human::Gene::bey2
package Human::Gene::bey2;
use Moose;
use Moose::Util::TypeConstraints;
type 'bey2_color' => where { $_ =~ m{^(?:brown|blue)$} };
has 'color' => ( is => 'ro', isa => 'bey2_color' );
This class is trivial. We have a type constraint for the allowed
colors, and a C<color> attribute.
=head2 Human::Gene::gey
package Human::Gene::gey;
use Moose;
use Moose::Util::TypeConstraints;
type 'gey_color' => where { $_ =~ m{^(?:green|blue)$} };
has 'color' => ( is => 'ro', isa => 'gey_color' );
This is nearly identical to the C<Humane::Gene::bey2> class, except
that the I<gey> gene allows for different colors.
=head1 EYE COLOR
We could just give four attributes (two of each gene) to the
C<Human> class, but this is a bit messy. Instead, we'll abstract the
genes into a container class, C<Human::EyeColor>. Then a C<Human> can
have a single C<eye_color> attribute.
package Human::EyeColor;
use Moose;
use Moose::Util::TypeConstraints;
coerce 'Human::Gene::bey2'
=> from 'Str'
=> via { Human::Gene::bey2->new( color => $_ ) };
coerce 'Human::Gene::gey'
=> from 'Str'
=> via { Human::Gene::gey->new( color => $_ ) };
has [qw( bey2_1 bey2_2 )] =>
( is => 'ro', isa => 'Human::Gene::bey2', coerce => 1 );
has [qw( gey_1 gey_2 )] =>
( is => 'ro', isa => 'Human::Gene::gey', coerce => 1 );
The eye color class has two of each type of gene. We've also created a
coercion for each class that coerces a string into a new object. Note
that a coercion will fail if it attempts to coerce a string like
"indigo", because that is not a valid color for either type of gene.
As an aside, you can see that we can define several identical
attributes at once by supplying an array reference of names as the first
argument to C<has>.
We also need a method to calculate the actual eye color that results
from a set of genes. The I<bey2> brown gene is dominant over both blue
and green. The I<gey> green gene is dominant over blue.
sub color {
my ($self) = @_;
return 'brown'
if ( $self->bey2_1->color() eq 'brown'
or $self->bey2_2->color() eq 'brown' );
return 'green'
if ( $self->gey_1->color() eq 'green'
or $self->gey_2->color() eq 'green' );
return 'blue';
}
We'd like to be able to treat a C<Human::EyeColor> object as a string,
so we define a string overloading for the class:
use overload '""' => \&color, fallback => 1;
Finally, we need to define overloading for addition. That way we can
add together two C<Human::EyeColor> objects and get a new one with a
new (genetically correct) eye color.
use overload '+' => \&_overload_add, fallback => 1;
sub _overload_add {
my ( $one, $two ) = @_;
my $one_bey2 = 'bey2_' . _rand2();
my $two_bey2 = 'bey2_' . _rand2();
my $one_gey = 'gey_' . _rand2();
my $two_gey = 'gey_' . _rand2();
return Human::EyeColor->new(
bey2_1 => $one->$one_bey2->color(),
bey2_2 => $two->$two_bey2->color(),
gey_1 => $one->$one_gey->color(),
gey_2 => $two->$two_gey->color(),
);
}
sub _rand2 {
return 1 + int( rand(2) );
}
When two eye color objects are added together, the C<_overload_add()>
method will be passed two C<Human::EyeColor> objects. These are the
left and right side operands for the C<+> operator. This method
returns a new C<Human::EyeColor> object.
=head1 ADDING EYE COLOR TO C<Human>s
Our original C<Human> class requires just a few changes to incorporate
our new C<Human::EyeColor> class.
use List::Util 1.56 qw( mesh );
coerce 'Human::EyeColor'
=> from 'ArrayRef'
=> via { my @genes = qw( bey2_1 bey2_2 gey_1 gey_2 );
return Human::EyeColor->new( mesh ( \@genes, $_ ) ); };
has 'eye_color' => (
is => 'ro',
isa => 'Human::EyeColor',
coerce => 1,
required => 1,
);
We also need to modify C<_overload_add()> in the C<Human> class to
account for eye color:
return Human->new(
sex => $sex,
eye_color => ( $one->eye_color() + $two->eye_color() ),
mother => $mother,
father => $father,
);
=head1 CONCLUSION
The three techniques we used, overloading, subtypes, and coercion,
combine to provide a powerful interface.
If you'd like to learn more about overloading, please read the
documentation for the L<overload> pragma.
To see all the code we created together, take a look at
F<t/recipes/basics_genome_overloadingsubtypesandcoercion.t>.
=head1 NEXT STEPS
Had this been a real project we'd probably want:
=over 4
=item Better Randomization with Crypt::Random
=item Characteristic Base Class
=item Mutating Genes
=item More Characteristics
=item Artificial Life
=back
=head1 AUTHORS
=over 4
=item *
Stevan Little <stevan@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This work is licensed under a Creative Commons Attribution 3.0 Unported License.
License details are at: L<http://creativecommons.org/licenses/by/3.0/>
=cut

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

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

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

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

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

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

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

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

153
CPAN/Moose/Cookbook/Extending/Debugging_BaseClassRole.pod Normal file
View File

@@ -0,0 +1,153 @@
# 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.2207
=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::Needs 'Test::Output';
use 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@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

404
CPAN/Moose/Cookbook/Extending/ExtensionOverview.pod Normal file
View File

@@ -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.2207
=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@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

160
CPAN/Moose/Cookbook/Extending/Mooseish_MooseSugar.pod Normal file
View File

@@ -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.2207
=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@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

172
CPAN/Moose/Cookbook/Legacy/Debugging_BaseClassReplacement.pod Normal file
View File

@@ -0,0 +1,172 @@
# 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.2207
=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::Needs 'Test::Output';
use 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 AUTHORS
=over 4
=item *
Stevan Little <stevan@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

337
CPAN/Moose/Cookbook/Legacy/Labeled_AttributeMetaclass.pod Normal file
View File

@@ -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.2207
=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@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

132
CPAN/Moose/Cookbook/Legacy/Table_ClassMetaclass.pod Normal file
View File

@@ -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.2207
=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@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

304
CPAN/Moose/Cookbook/Meta/GlobRef_InstanceMetaclass.pod Normal file
View File

@@ -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.2207
=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@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

325
CPAN/Moose/Cookbook/Meta/Labeled_AttributeTrait.pod Normal file
View File

@@ -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.2207
=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@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

224
CPAN/Moose/Cookbook/Meta/PrivateOrPublic_MethodMetaclass.pod Normal file
View File

@@ -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.2207
=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@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

157
CPAN/Moose/Cookbook/Meta/Table_MetaclassTrait.pod Normal file
View File

@@ -0,0 +1,157 @@
# 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.2207
=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
=pod
=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@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

117
CPAN/Moose/Cookbook/Meta/WhyMeta.pod Normal file
View File

@@ -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.2207
=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@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

191
CPAN/Moose/Cookbook/Roles/ApplicationToInstance.pod Normal file
View File

@@ -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.2207
=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@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

379
CPAN/Moose/Cookbook/Roles/Comparable_CodeReuse.pod Normal file
View File

@@ -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.2207
=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@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

230
CPAN/Moose/Cookbook/Roles/Restartable_AdvancedComposition.pod Normal file
View File

@@ -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.2207
=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@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

240
CPAN/Moose/Cookbook/Snack/Keywords.pod Normal file
View File

@@ -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.2207
=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@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

130
CPAN/Moose/Cookbook/Snack/Types.pod Normal file
View File

@@ -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.2207
=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@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

77
CPAN/Moose/Cookbook/Style.pod Normal file
View File

@@ -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.2207
=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@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

98
CPAN/Moose/Deprecated.pm Normal file
View File

@@ -0,0 +1,98 @@
package Moose::Deprecated;
our $VERSION = '2.2207';
use strict;
use warnings;
use Package::DeprecationManager 0.07 -deprecations => {
'non-arrayref form of enum' => '2.1100',
'non-arrayref form of duck_type' => '2.1100',
},
-ignore => [qr/^(?:Class::MOP|Moose)(?:::)?/],
;
1;
# ABSTRACT: Manages deprecation warnings for Moose
__END__
=pod
=encoding UTF-8
=head1 NAME
Moose::Deprecated - Manages deprecation warnings for Moose
=head1 VERSION
version 2.2207
=head1 DESCRIPTION
use Moose::Deprecated -api_version => $version;
=head1 FUNCTIONS
This module manages deprecation warnings for features that have been
deprecated in Moose.
If you specify C<< -api_version => $version >>, you can use deprecated features
without warnings. Note that this special treatment is limited to the package
that loads C<Moose::Deprecated>.
=head1 AUTHORS
=over 4
=item *
Stevan Little <stevan@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

211
CPAN/Moose/Exception.pm Normal file
View File

@@ -0,0 +1,211 @@
package Moose::Exception;
our $VERSION = '2.2207';
use Moose;
use Devel::StackTrace 2.03;
has 'trace' => (
is => 'ro',
isa => 'Devel::StackTrace',
builder => '_build_trace',
lazy => 1,
documentation => "This attribute is read-only and isa L<Devel::StackTrace>. ".
'It is lazy & dependent on $exception->message.'
);
has 'message' => (
is => 'ro',
isa => 'Defined',
builder => '_build_message',
lazy => 1,
documentation => "This attribute is read-only and isa Defined. ".
"It is lazy and has a default value 'Error'."
);
use overload(
q{""} => 'as_string',
bool => sub () { 1 },
fallback => 1,
);
sub _build_trace {
my $self = shift;
# skip frames that are method calls on the exception object, which include
# the object itself in the arguments (but Devel::LeakTrace really ought to
# be weakening all references in its frames)
my $skip = 0;
while (my @c = caller(++$skip)) {
last if ($c[3] =~ /^(.*)::new$/ || $c[3] =~ /^\S+ (.*)::new \(defined at /)
&& $self->isa($1);
}
$skip++;
Devel::StackTrace->new(
message => $self->message,
indent => 1,
skip_frames => $skip,
no_refs => 1,
);
}
sub _build_message {
"Error";
}
sub BUILD {
my $self = shift;
$self->trace;
}
sub as_string {
my $self = shift;
if ( $ENV{MOOSE_FULL_EXCEPTION} ) {
return $self->trace->as_string;
}
my @frames;
my $last_frame;
my $in_moose = 1;
for my $frame ( $self->trace->frames ) {
if ( $in_moose && $frame->package =~ /^(?:Moose|Class::MOP)(?::|$)/ )
{
$last_frame = $frame;
next;
}
elsif ($last_frame) {
push @frames, $last_frame;
undef $last_frame;
}
$in_moose = 0;
push @frames, $frame;
}
# This would be a somewhat pathological case, but who knows
return $self->trace->as_string unless @frames;
my $message = ( shift @frames )->as_string( 1, {} ) . "\n";
$message .= join q{}, map { $_->as_string( 0, {} ) . "\n" } @frames;
return $message;
}
__PACKAGE__->meta->make_immutable;
1;
# ABSTRACT: Superclass for Moose internal exceptions
__END__
=pod
=encoding UTF-8
=head1 NAME
Moose::Exception - Superclass for Moose internal exceptions
=head1 VERSION
version 2.2207
=head1 DESCRIPTION
This class contains attributes which are common to all Moose internal
exception classes.
=head1 WARNING WARNING WARNING
If you're writing your own exception classes, you should instead prefer
the L<Throwable> role or the L<Throwable::Error> superclass - this is
effectively a cut-down internal fork of the latter, and not designed
for use in user code.
Of course if you're writing metaclass traits, it would then make sense to
subclass the relevant Moose exceptions - but only then.
=head1 METHODS
=head2 $exception->message
This attribute contains the exception message.
Every subclass of L<Moose::Exception> is expected to override
C<_build_message> method in order to construct this value.
=head2 $exception->trace
This attribute contains the stack trace for the given exception. It returns a
L<Devel::StackTrace> object.
=head2 $exception->as_string
This method returns a stringified form of the exception, including a stack
trace. By default, this method skips Moose-internal stack frames until it sees
a caller outside of the Moose core. If the C<MOOSE_FULL_EXCEPTION> environment
variable is true, these frames are included.
=head1 SEE ALSO
=over 4
=item * L<Moose::Manual::Exceptions>
=back
=head1 AUTHORS
=over 4
=item *
Stevan Little <stevan@cpan.org>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@cpan.org>
=item *
Shawn M Moore <sartak@cpan.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mstrout@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This 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

14
CPAN/Moose/Exception/AccessorMustReadWrite.pm Normal file
View File

@@ -0,0 +1,14 @@
package Moose::Exception::AccessorMustReadWrite;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::InvalidAttributeOptions';
sub _build_message {
my $self = shift;
"Cannot define an accessor name on a read-only attribute, accessors are read/write";
}
__PACKAGE__->meta->make_immutable;
1;

19
CPAN/Moose/Exception/AddParameterizableTypeTakesParameterizableType.pm Normal file
View File

@@ -0,0 +1,19 @@
package Moose::Exception::AddParameterizableTypeTakesParameterizableType;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
has 'type_name' => (
is => 'ro',
isa => 'Str',
required => 1
);
sub _build_message {
my $self = shift;
"Type must be a Moose::Meta::TypeConstraint::Parameterizable not ".$self->type_name;
}
__PACKAGE__->meta->make_immutable;
1;

19
CPAN/Moose/Exception/AddRoleTakesAMooseMetaRoleInstance.pm Normal file
View File

@@ -0,0 +1,19 @@
package Moose::Exception::AddRoleTakesAMooseMetaRoleInstance;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Class';
has 'role_to_be_added' => (
is => 'ro',
isa => 'Any',
required => 1,
);
sub _build_message {
"Roles must be instances of Moose::Meta::Role";
}
__PACKAGE__->meta->make_immutable;
1;

19
CPAN/Moose/Exception/AddRoleToARoleTakesAMooseMetaRole.pm Normal file
View File

@@ -0,0 +1,19 @@
package Moose::Exception::AddRoleToARoleTakesAMooseMetaRole;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Role';
has 'role_to_be_added' => (
is => 'ro',
isa => 'Any',
required => 1,
);
sub _build_message {
"Roles must be instances of Moose::Meta::Role";
}
__PACKAGE__->meta->make_immutable;
1;

19
CPAN/Moose/Exception/ApplyTakesABlessedInstance.pm Normal file
View File

@@ -0,0 +1,19 @@
package Moose::Exception::ApplyTakesABlessedInstance;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Role';
has 'param' => (
is => 'ro',
isa => 'Any',
required => 1,
);
sub _build_message {
"You must pass in an blessed instance";
}
__PACKAGE__->meta->make_immutable;
1;

19
CPAN/Moose/Exception/AttachToClassNeedsAClassMOPClassInstanceOrASubclass.pm Normal file
View File

@@ -0,0 +1,19 @@
package Moose::Exception::AttachToClassNeedsAClassMOPClassInstanceOrASubclass;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Attribute';
has 'class' => (
is => 'ro',
isa => 'Any',
required => 1
);
sub _build_message {
"You must pass a Class::MOP::Class instance (or a subclass)";
}
__PACKAGE__->meta->make_immutable;
1;

32
CPAN/Moose/Exception/AttributeConflictInRoles.pm Normal file
View File

@@ -0,0 +1,32 @@
package Moose::Exception::AttributeConflictInRoles;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Role';
has 'second_role_name' => (
is => 'ro',
isa => 'Str',
required => 1
);
has 'attribute_name' => (
is => 'ro',
isa => 'Str',
required => 1
);
sub _build_message {
my $self = shift;
my $role_name = $self->role_name;
my $second_role_name = $self->second_role_name;
my $attribute_name = $self->attribute_name;
"Role '$role_name' has encountered an attribute conflict"
. " while being composed into '$second_role_name'."
. " This is a fatal error and cannot be disambiguated."
. " The conflicting attribute is named '$attribute_name'.";
}
__PACKAGE__->meta->make_immutable;
1;

28
CPAN/Moose/Exception/AttributeConflictInSummation.pm Normal file
View File

@@ -0,0 +1,28 @@
package Moose::Exception::AttributeConflictInSummation;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Role', 'Moose::Exception::Role::AttributeName';
has 'second_role_name' => (
is => 'ro',
isa => 'Str',
required => 1,
);
sub _build_message {
my $self = shift;
my $role1 = $self->role_name;
my $role2 = $self->second_role_name;
my $attr_name = $self->attribute_name;
return "We have encountered an attribute conflict with '$attr_name'"
. " during role composition. "
. " This attribute is defined in both $role1 and $role2."
. " This is a fatal error and cannot be disambiguated.";
}
__PACKAGE__->meta->make_immutable;
1;

19
CPAN/Moose/Exception/AttributeExtensionIsNotSupportedInRoles.pm Normal file
View File

@@ -0,0 +1,19 @@
package Moose::Exception::AttributeExtensionIsNotSupportedInRoles;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Role';
has 'attribute_name' => (
is => 'ro',
isa => 'Str',
required => 1,
);
sub _build_message {
"has '+attr' is not supported in roles";
}
__PACKAGE__->meta->make_immutable;
1;

45
CPAN/Moose/Exception/AttributeIsRequired.pm Normal file
View File

@@ -0,0 +1,45 @@
package Moose::Exception::AttributeIsRequired;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Class';
has 'attribute_name' => (
is => 'ro',
isa => 'Str',
required => 1,
documentation => "This attribute can be used for fetching attribute instance:\n".
" my \$class = Moose::Util::find_meta( \$exception->class_name );\n".
" my \$attribute = \$class->get_attribute( \$exception->attribute_name );\n",
);
has 'attribute_init_arg' => (
is => 'ro',
isa => 'Str',
);
has 'params' => (
is => 'ro',
isa => 'HashRef',
predicate => 'has_params',
);
sub _build_message {
my $self = shift;
my $name = $self->attribute_name;
my $msg = "Attribute ($name)";
my $init_arg = $self->attribute_init_arg;
if ( defined $init_arg && $name ne $init_arg ) {
$msg .= ", passed as ($init_arg),";
}
$msg .= ' is required';
return $msg;
}
__PACKAGE__->meta->make_immutable;
1;

19
CPAN/Moose/Exception/AttributeMustBeAnClassMOPMixinAttributeCoreOrSubclass.pm Normal file
View File

@@ -0,0 +1,19 @@
package Moose::Exception::AttributeMustBeAnClassMOPMixinAttributeCoreOrSubclass;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Class';
has 'attribute' => (
is => 'ro',
isa => 'Any',
required => 1
);
sub _build_message {
"Your attribute must be an instance of Class::MOP::Mixin::AttributeCore (or a subclass)";
}
__PACKAGE__->meta->make_immutable;
1;

25
CPAN/Moose/Exception/AttributeNamesDoNotMatch.pm Normal file
View File

@@ -0,0 +1,25 @@
package Moose::Exception::AttributeNamesDoNotMatch;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
has attribute_name => (
is => 'ro',
isa => 'Str',
required => 1,
);
has attribute => (
is => 'ro',
isa => 'Class::MOP::Attribute',
required => 1,
);
sub _build_message {
my $self = shift;
"attribute_name (".$self-> attribute_name.") does not match attribute->name (".$self->attribute->name.")";
}
__PACKAGE__->meta->make_immutable;
1;

28
CPAN/Moose/Exception/AttributeValueIsNotAnObject.pm Normal file
View File

@@ -0,0 +1,28 @@
package Moose::Exception::AttributeValueIsNotAnObject;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Instance', 'Moose::Exception::Role::Attribute';
has 'method' => (
is => 'ro',
isa => 'Moose::Meta::Method::Delegation',
required => 1,
);
has 'given_value' => (
is => 'ro',
isa => 'Any',
required => 1,
);
sub _build_message {
my $self = shift;
"Cannot delegate ".$self->method->name." to "
.$self->method->delegate_to_method." because the value of "
. $self->attribute->name . " is not an object (got '".$self->given_value."')";
}
__PACKAGE__->meta->make_immutable;
1;

22
CPAN/Moose/Exception/AttributeValueIsNotDefined.pm Normal file
View File

@@ -0,0 +1,22 @@
package Moose::Exception::AttributeValueIsNotDefined;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Instance', 'Moose::Exception::Role::Attribute';
has 'method' => (
is => 'ro',
isa => 'Moose::Meta::Method::Delegation',
required => 1,
);
sub _build_message {
my $self = shift;
"Cannot delegate ".$self->method->name." to "
.$self->method->delegate_to_method." because the value of "
. $self->attribute->name . " is not defined";
}
__PACKAGE__->meta->make_immutable;
1;

14
CPAN/Moose/Exception/AutoDeRefNeedsArrayRefOrHashRef.pm Normal file
View File

@@ -0,0 +1,14 @@
package Moose::Exception::AutoDeRefNeedsArrayRefOrHashRef;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::InvalidAttributeOptions';
sub _build_message {
my $self = shift;
"You cannot auto-dereference anything other than a ArrayRef or HashRef on attribute (".$self->attribute_name.")";
}
__PACKAGE__->meta->make_immutable;
1;

25
CPAN/Moose/Exception/BadOptionFormat.pm Normal file
View File

@@ -0,0 +1,25 @@
package Moose::Exception::BadOptionFormat;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Attribute';
has 'option_name' => (
is => 'ro',
isa => 'Str',
required => 1
);
has 'option_value' => (
is => 'ro',
isa => 'Any',
required => 1
);
sub _build_message {
"bad accessor/reader/writer/predicate/clearer format, must be a HASH ref";
}
__PACKAGE__->meta->make_immutable;
1;

19
CPAN/Moose/Exception/BothBuilderAndDefaultAreNotAllowed.pm Normal file
View File

@@ -0,0 +1,19 @@
package Moose::Exception::BothBuilderAndDefaultAreNotAllowed;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::ParamsHash';
has 'class' => (
is => 'ro',
isa => 'Str',
required => 1
);
sub _build_message {
"Setting both default and builder is not allowed.";
}
__PACKAGE__->meta->make_immutable;
1;

14
CPAN/Moose/Exception/BuilderDoesNotExist.pm Normal file
View File

@@ -0,0 +1,14 @@
package Moose::Exception::BuilderDoesNotExist;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Attribute', 'Moose::Exception::Role::Instance';
sub _build_message {
my $self = shift;
blessed($self->instance)." does not support builder method '".$self->attribute->builder."' for attribute '".$self->attribute->name."'";
}
__PACKAGE__->meta->make_immutable;
1;

14
CPAN/Moose/Exception/BuilderMethodNotSupportedForAttribute.pm Normal file
View File

@@ -0,0 +1,14 @@
package Moose::Exception::BuilderMethodNotSupportedForAttribute;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Attribute', 'Moose::Exception::Role::Instance';
sub _build_message {
my $self = shift;
blessed($self->instance)." does not support builder method '". $self->attribute->builder ."' for attribute '" . $self->attribute->name . "'";
}
__PACKAGE__->meta->make_immutable;
1;

26
CPAN/Moose/Exception/BuilderMethodNotSupportedForInlineAttribute.pm Normal file
View File

@@ -0,0 +1,26 @@
package Moose::Exception::BuilderMethodNotSupportedForInlineAttribute;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Instance', 'Moose::Exception::Role::Class';
has 'attribute_name' => (
is => 'ro',
isa => 'Str',
required => 1
);
has 'builder' => (
is => 'ro',
isa => 'Str',
required => 1
);
sub _build_message {
my $self = shift;
$self->class_name." does not support builder method '". $self->builder ."' for attribute '" . $self->attribute_name . "'";
}
__PACKAGE__->meta->make_immutable;
1;

19
CPAN/Moose/Exception/BuilderMustBeAMethodName.pm Normal file
View File

@@ -0,0 +1,19 @@
package Moose::Exception::BuilderMustBeAMethodName;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::ParamsHash';
has 'class' => (
is => 'ro',
isa => 'Str',
required => 1
);
sub _build_message {
"builder must be a defined scalar value which is a method name";
}
__PACKAGE__->meta->make_immutable;
1;

19
CPAN/Moose/Exception/CallingMethodOnAnImmutableInstance.pm Normal file
View File

@@ -0,0 +1,19 @@
package Moose::Exception::CallingMethodOnAnImmutableInstance;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
has 'method_name' => (
is => 'ro',
isa => 'Str',
required => 1
);
sub _build_message {
my $self = shift;
"The '".$self->method_name."' method cannot be called on an immutable instance";
}
__PACKAGE__->meta->make_immutable;
1;

19
CPAN/Moose/Exception/CallingReadOnlyMethodOnAnImmutableInstance.pm Normal file
View File

@@ -0,0 +1,19 @@
package Moose::Exception::CallingReadOnlyMethodOnAnImmutableInstance;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
has 'method_name' => (
is => 'ro',
isa => 'Str',
required => 1
);
sub _build_message {
my $self = shift;
"The '".$self->method_name."' method is read-only when called on an immutable instance";
}
__PACKAGE__->meta->make_immutable;
1;

15
CPAN/Moose/Exception/CanExtendOnlyClasses.pm Normal file
View File

@@ -0,0 +1,15 @@
package Moose::Exception::CanExtendOnlyClasses;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Role';
sub _build_message {
my $self = shift;
my $role_name = $self->role_name;
return "You cannot inherit from a Moose Role ($role_name)";
}
__PACKAGE__->meta->make_immutable;
1;

18
CPAN/Moose/Exception/CanOnlyConsumeRole.pm Normal file
View File

@@ -0,0 +1,18 @@
package Moose::Exception::CanOnlyConsumeRole;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
has 'role_name' => (
is => 'ro',
isa => 'Str',
required => 1,
);
sub _build_message {
my $self = shift;
"You can only consume roles, ".$self->role_name." is not a Moose role";
}
__PACKAGE__->meta->make_immutable;
1;

25
CPAN/Moose/Exception/CanOnlyWrapBlessedCode.pm Normal file
View File

@@ -0,0 +1,25 @@
package Moose::Exception::CanOnlyWrapBlessedCode;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::ParamsHash';
has 'class' => (
is => 'ro',
isa => 'Str',
required => 1
);
has 'code' => (
is => 'ro',
isa => 'Any',
required => 1
);
sub _build_message {
"Can only wrap blessed CODE";
}
__PACKAGE__->meta->make_immutable;
1;

15
CPAN/Moose/Exception/CanReblessOnlyIntoASubclass.pm Normal file
View File

@@ -0,0 +1,15 @@
package Moose::Exception::CanReblessOnlyIntoASubclass;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::ParamsHash', 'Moose::Exception::Role::Class', 'Moose::Exception::Role::Instance', 'Moose::Exception::Role::InstanceClass';
sub _build_message {
my $self = shift;
my $instance_class = $self->instance_class;
"You may rebless only into a subclass of ($instance_class), of which (". $self->class_name .") isn't."
}
__PACKAGE__->meta->make_immutable;
1;

14
CPAN/Moose/Exception/CanReblessOnlyIntoASuperclass.pm Normal file
View File

@@ -0,0 +1,14 @@
package Moose::Exception::CanReblessOnlyIntoASuperclass;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Class', 'Moose::Exception::Role::Instance', 'Moose::Exception::Role::InstanceClass';
sub _build_message {
my $self = shift;
"You may rebless only into a superclass of (".blessed( $self->instance )."), of which (". $self->class_name .") isn't."
}
__PACKAGE__->meta->make_immutable;
1;

18
CPAN/Moose/Exception/CannotAddAdditionalTypeCoercionsToUnion.pm Normal file
View File

@@ -0,0 +1,18 @@
package Moose::Exception::CannotAddAdditionalTypeCoercionsToUnion;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
has 'type_coercion_union_object' => (
is => 'ro',
isa => 'Moose::Meta::TypeCoercion::Union',
required => 1
);
sub _build_message {
return "Cannot add additional type coercions to Union types";
}
__PACKAGE__->meta->make_immutable;
1;

20
CPAN/Moose/Exception/CannotAddAsAnAttributeToARole.pm Normal file
View File

@@ -0,0 +1,20 @@
package Moose::Exception::CannotAddAsAnAttributeToARole;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Role';
has 'attribute_class' => (
is => 'ro',
isa => 'Str',
required => 1,
);
sub _build_message {
my $self = shift;
"Cannot add a ".$self->attribute_class." as an attribute to a role";
}
__PACKAGE__->meta->make_immutable;
1;

13
CPAN/Moose/Exception/CannotApplyBaseClassRolesToRole.pm Normal file
View File

@@ -0,0 +1,13 @@
package Moose::Exception::CannotApplyBaseClassRolesToRole;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::ParamsHash', 'Moose::Exception::Role::Role';
sub _build_message {
"You can only apply base class roles to a Moose class, not a role.";
}
__PACKAGE__->meta->make_immutable;
1;

20
CPAN/Moose/Exception/CannotAssignValueToReadOnlyAccessor.pm Normal file
View File

@@ -0,0 +1,20 @@
package Moose::Exception::CannotAssignValueToReadOnlyAccessor;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Class', 'Moose::Exception::Role::EitherAttributeOrAttributeName';
has 'value' => (
is => 'ro',
isa => 'Any',
required => 1
);
sub _build_message {
my $self = shift;
"Cannot assign a value to a read-only accessor";
}
__PACKAGE__->meta->make_immutable;
1;

13
CPAN/Moose/Exception/CannotAugmentIfLocalMethodPresent.pm Normal file
View File

@@ -0,0 +1,13 @@
package Moose::Exception::CannotAugmentIfLocalMethodPresent;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Class', 'Moose::Exception::Role::Method';
sub _build_message {
"Cannot add an augment method if a local method is already present";
}
__PACKAGE__->meta->make_immutable;
1;

26
CPAN/Moose/Exception/CannotAugmentNoSuperMethod.pm Normal file
View File

@@ -0,0 +1,26 @@
package Moose::Exception::CannotAugmentNoSuperMethod;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::ParamsHash';
has 'class' => (
is => 'ro',
isa => 'Str',
required => 1
);
has 'method_name' => (
is => 'ro',
isa => 'Str',
required => 1
);
sub _build_message {
my $self = shift;
"You cannot augment '".$self->method_name."' because it has no super method";
}
__PACKAGE__->meta->make_immutable;
1;

14
CPAN/Moose/Exception/CannotAutoDerefWithoutIsa.pm Normal file
View File

@@ -0,0 +1,14 @@
package Moose::Exception::CannotAutoDerefWithoutIsa;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::InvalidAttributeOptions';
sub _build_message {
my $self = shift;
"You cannot auto-dereference without specifying a type constraint on attribute (".$self->attribute_name.")";
}
__PACKAGE__->meta->make_immutable;
1;

14
CPAN/Moose/Exception/CannotAutoDereferenceTypeConstraint.pm Normal file
View File

@@ -0,0 +1,14 @@
package Moose::Exception::CannotAutoDereferenceTypeConstraint;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Attribute', 'Moose::Exception::Role::Instance', 'Moose::Exception::Role::TypeConstraint';
sub _build_message {
my $self = shift;
"Can not auto de-reference the type constraint '" . $self->type_name . "'";
}
__PACKAGE__->meta->make_immutable;
1;

14
CPAN/Moose/Exception/CannotCalculateNativeType.pm Normal file
View File

@@ -0,0 +1,14 @@
package Moose::Exception::CannotCalculateNativeType;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Instance';
sub _build_message {
my $self = shift;
"Cannot calculate native type for " . ref $self->instance;
}
__PACKAGE__->meta->make_immutable;
1;

19
CPAN/Moose/Exception/CannotCallAnAbstractBaseMethod.pm Normal file
View File

@@ -0,0 +1,19 @@
package Moose::Exception::CannotCallAnAbstractBaseMethod;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
has 'package_name' => (
is => 'ro',
isa => 'Str',
required => 1
);
sub _build_message {
my $self = shift;
$self->package_name. " is an abstract base class, you must provide a constructor.";
}
__PACKAGE__->meta->make_immutable;
1;

12
CPAN/Moose/Exception/CannotCallAnAbstractMethod.pm Normal file
View File

@@ -0,0 +1,12 @@
package Moose::Exception::CannotCallAnAbstractMethod;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
sub _build_message {
"Abstract method";
}
__PACKAGE__->meta->make_immutable;
1;

14
CPAN/Moose/Exception/CannotCoerceAWeakRef.pm Normal file
View File

@@ -0,0 +1,14 @@
package Moose::Exception::CannotCoerceAWeakRef;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::InvalidAttributeOptions';
sub _build_message {
my $self = shift;
"You cannot have a weak reference to a coerced value on attribute (".$self->attribute_name.")";
}
__PACKAGE__->meta->make_immutable;
1;

17
CPAN/Moose/Exception/CannotCoerceAttributeWhichHasNoCoercion.pm Normal file
View File

@@ -0,0 +1,17 @@
package Moose::Exception::CannotCoerceAttributeWhichHasNoCoercion;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::InvalidAttributeOptions', 'Moose::Exception::Role::TypeConstraint';
sub _build_message {
my $self = shift;
my $name = $self->attribute_name;
my $type = $self->type_name;
return "You cannot coerce an attribute ($name) unless its type ($type) has a coercion";
}
__PACKAGE__->meta->make_immutable;
1;

13
CPAN/Moose/Exception/CannotCreateHigherOrderTypeWithoutATypeParameter.pm Normal file
View File

@@ -0,0 +1,13 @@
package Moose::Exception::CannotCreateHigherOrderTypeWithoutATypeParameter;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::TypeConstraint';
sub _build_message {
"You cannot create a Higher Order type without a type parameter";
}
__PACKAGE__->meta->make_immutable;
1;

25
CPAN/Moose/Exception/CannotCreateMethodAliasLocalMethodIsPresent.pm Normal file
View File

@@ -0,0 +1,25 @@
package Moose::Exception::CannotCreateMethodAliasLocalMethodIsPresent;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Role', 'Moose::Exception::Role::Method';
has 'role_being_applied_name' => (
is => 'ro',
isa => 'Str',
required => 1
);
has 'aliased_method_name' => (
is => 'ro',
isa => 'Str',
required => 1
);
sub _build_message {
"Cannot create a method alias if a local method of the same name exists";
}
__PACKAGE__->meta->make_immutable;
1;

19
CPAN/Moose/Exception/CannotCreateMethodAliasLocalMethodIsPresentInClass.pm Normal file
View File

@@ -0,0 +1,19 @@
package Moose::Exception::CannotCreateMethodAliasLocalMethodIsPresentInClass;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Role', 'Moose::Exception::Role::Method', 'Moose::Exception::Role::Class';
has 'aliased_method_name' => (
is => 'ro',
isa => 'Str',
required => 1
);
sub _build_message {
"Cannot create a method alias if a local method of the same name exists";
}
__PACKAGE__->meta->make_immutable;
1;

14
CPAN/Moose/Exception/CannotDelegateLocalMethodIsPresent.pm Normal file
View File

@@ -0,0 +1,14 @@
package Moose::Exception::CannotDelegateLocalMethodIsPresent;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Attribute', 'Moose::Exception::Role::Method';
sub _build_message {
my $self = shift;
"You cannot overwrite a locally defined method (".$self->method->name.") with a delegation";
}
__PACKAGE__->meta->make_immutable;
1;

13
CPAN/Moose/Exception/CannotDelegateWithoutIsa.pm Normal file
View File

@@ -0,0 +1,13 @@
package Moose::Exception::CannotDelegateWithoutIsa;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Attribute';
sub _build_message {
"Cannot delegate methods based on a Regexp without a type constraint (isa)";
}
__PACKAGE__->meta->make_immutable;
1;

14
CPAN/Moose/Exception/CannotFindDelegateMetaclass.pm Normal file
View File

@@ -0,0 +1,14 @@
package Moose::Exception::CannotFindDelegateMetaclass;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Attribute';
sub _build_message {
my $self = shift;
"Cannot find delegate metaclass for attribute ".$self->attribute->name;
}
__PACKAGE__->meta->make_immutable;
1;

19
CPAN/Moose/Exception/CannotFindType.pm Normal file
View File

@@ -0,0 +1,19 @@
package Moose::Exception::CannotFindType;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
has 'type_name' => (
is => 'ro',
isa => 'Str',
required => 1
);
sub _build_message {
my $self = shift;
"Cannot find type '".$self->type_name."', perhaps you forgot to load it";
}
__PACKAGE__->meta->make_immutable;
1;

33
CPAN/Moose/Exception/CannotFindTypeGivenToMatchOnType.pm Normal file
View File

@@ -0,0 +1,33 @@
package Moose::Exception::CannotFindTypeGivenToMatchOnType;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
has 'to_match' => (
is => 'ro',
isa => 'Any',
required => 1
);
has 'action' => (
is => 'ro',
isa => 'Any',
required => 1
);
has 'type' => (
is => 'ro',
isa => 'Any',
required => 1
);
sub _build_message {
my $self = shift;
my $type = $self->type;
return "Cannot find or parse the type '$type'"
}
__PACKAGE__->meta->make_immutable;
1;

26
CPAN/Moose/Exception/CannotFixMetaclassCompatibility.pm Normal file
View File

@@ -0,0 +1,26 @@
package Moose::Exception::CannotFixMetaclassCompatibility;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Class';
has 'superclass' => (
is => 'ro',
isa => 'Object',
required => 1
);
has 'metaclass_type' => (
is => 'ro',
isa => 'Str',
);
sub _build_message {
my $self = shift;
my $class_name = $self->class_name;
"Can't fix metaclass incompatibility for $class_name because it is not pristine.";
}
__PACKAGE__->meta->make_immutable;
1;

30
CPAN/Moose/Exception/CannotGenerateInlineConstraint.pm Normal file
View File

@@ -0,0 +1,30 @@
package Moose::Exception::CannotGenerateInlineConstraint;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::TypeConstraint';
has 'parameterizable_type_object_name' => (
is => 'ro',
isa => 'Str',
required => 1,
documentation => "This attribute can be used for fetching parameterizable type constraint(Moose::Meta::TypeConstraint::Parameterizable):\n".
" my \$type_constraint = Moose::Util::TypeConstraints::find_type_constraint( \$exception->type_name );\n",
);
has 'value' => (
is => 'ro',
isa => 'Str',
required => 1
);
sub _build_message {
my $self = shift;
my $type = $self->type_name;
return "Can't generate an inline constraint for $type, since none was defined";
}
__PACKAGE__->meta->make_immutable;
1;

30
CPAN/Moose/Exception/CannotInitializeMooseMetaRoleComposite.pm Normal file
View File

@@ -0,0 +1,30 @@
package Moose::Exception::CannotInitializeMooseMetaRoleComposite;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
has 'role_composite' => (
is => 'ro',
isa => 'Moose::Meta::Role::Composite',
required => 1
);
has 'old_meta' => (
is => 'ro',
isa => 'Any',
required => 1
);
has 'args' => (
is => 'ro',
isa => 'ArrayRef',
required => 1
);
sub _build_message {
'Moose::Meta::Role::Composite instances can only be reinitialized from an existing metaclass instance';
}
__PACKAGE__->meta->make_immutable;
1;

14
CPAN/Moose/Exception/CannotInlineTypeConstraintCheck.pm Normal file
View File

@@ -0,0 +1,14 @@
package Moose::Exception::CannotInlineTypeConstraintCheck;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::TypeConstraint';
sub _build_message {
my $self = shift;
'Cannot inline a type constraint check for ' . $self->type_name;
}
__PACKAGE__->meta->make_immutable;
1;

41
CPAN/Moose/Exception/CannotLocatePackageInINC.pm Normal file
View File

@@ -0,0 +1,41 @@
package Moose::Exception::CannotLocatePackageInINC;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::ParamsHash';
has 'INC' => (
is => 'ro',
isa => 'ArrayRef',
required => 1
);
has 'possible_packages' => (
is => 'ro',
isa => 'Str',
required => 1
);
has 'metaclass_name' => (
is => 'ro',
isa => 'Str',
required => 1
);
has 'type' => (
is => 'ro',
isa => 'Str',
required => 1,
);
sub _build_message {
my $self = shift;
my $possible_packages = $self->possible_packages;
my @inc = @{$self->INC};
return "Can't locate $possible_packages in \@INC (\@INC contains: @INC)."
}
__PACKAGE__->meta->make_immutable;
1;

23
CPAN/Moose/Exception/CannotMakeMetaclassCompatible.pm Normal file
View File

@@ -0,0 +1,23 @@
package Moose::Exception::CannotMakeMetaclassCompatible;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Class';
has 'superclass_name' => (
is => 'ro',
isa => 'Str',
required => 1
);
sub _build_message {
my $self = shift;
my $class_name = $self->class_name;
my $superclass = $self->superclass_name;
return "Can't make $class_name compatible with metaclass $superclass";
}
__PACKAGE__->meta->make_immutable;
1;

20
CPAN/Moose/Exception/CannotOverrideALocalMethod.pm Normal file
View File

@@ -0,0 +1,20 @@
package Moose::Exception::CannotOverrideALocalMethod;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Role';
has 'method_name' => (
is => 'ro',
isa => 'Str',
required => 1,
);
sub _build_message {
my $self = shift;
"Cannot add an override of method '".$self->method_name."' because there is a local version of '".$self->method_name."'";
}
__PACKAGE__->meta->make_immutable;
1;

19
CPAN/Moose/Exception/CannotOverrideBodyOfMetaMethods.pm Normal file
View File

@@ -0,0 +1,19 @@
package Moose::Exception::CannotOverrideBodyOfMetaMethods;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::ParamsHash';
has 'class' => (
is => 'ro',
isa => 'Str',
required => 1
);
sub _build_message {
"Overriding the body of meta methods is not allowed";
}
__PACKAGE__->meta->make_immutable;
1;

13
CPAN/Moose/Exception/CannotOverrideLocalMethodIsPresent.pm Normal file
View File

@@ -0,0 +1,13 @@
package Moose::Exception::CannotOverrideLocalMethodIsPresent;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Class', 'Moose::Exception::Role::Method';
sub _build_message {
"Cannot add an override method if a local method is already present";
}
__PACKAGE__->meta->make_immutable;
1;

26
CPAN/Moose/Exception/CannotOverrideNoSuperMethod.pm Normal file
View File

@@ -0,0 +1,26 @@
package Moose::Exception::CannotOverrideNoSuperMethod;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::ParamsHash';
has 'method_name' => (
is => 'ro',
isa => 'Str',
required => 1
);
has 'class' => (
is => 'ro',
isa => 'Str',
required => 1
);
sub _build_message {
my $self = shift;
"You cannot override '".$self->method_name."' because it has no super method";
}
__PACKAGE__->meta->make_immutable;
1;

12
CPAN/Moose/Exception/CannotRegisterUnnamedTypeConstraint.pm Normal file
View File

@@ -0,0 +1,12 @@
package Moose::Exception::CannotRegisterUnnamedTypeConstraint;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
sub _build_message {
"can't register an unnamed type constraint";
}
__PACKAGE__->meta->make_immutable;
1;

14
CPAN/Moose/Exception/CannotUseLazyBuildAndDefaultSimultaneously.pm Normal file
View File

@@ -0,0 +1,14 @@
package Moose::Exception::CannotUseLazyBuildAndDefaultSimultaneously;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::InvalidAttributeOptions';
sub _build_message {
my $self = shift;
"You can not use lazy_build and default for the same attribute (".$self->attribute_name.")";
}
__PACKAGE__->meta->make_immutable;
1;

31
CPAN/Moose/Exception/CircularReferenceInAlso.pm Normal file
View File

@@ -0,0 +1,31 @@
package Moose::Exception::CircularReferenceInAlso;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
has 'also_parameter' => (
is => 'ro',
isa => 'Str',
required => 1
);
has 'stack' => (
is => 'ro',
isa => 'ArrayRef',
required => 1
);
sub _build_message {
my $self = shift;
my $also_member = $self->also_parameter;
my @stack = @{$self->stack};
my $existing_stack = join( ', ', @stack);
return "Circular reference in 'also' parameter to Moose::Exporter between "
."$existing_stack and $also_member";
}
__PACKAGE__->meta->make_immutable;
1;

22
CPAN/Moose/Exception/ClassDoesNotHaveInitMeta.pm Normal file
View File

@@ -0,0 +1,22 @@
package Moose::Exception::ClassDoesNotHaveInitMeta;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Class';
has 'traits' => (
is => 'ro',
isa => 'ArrayRef',
required => 1
);
sub _build_message {
my $self = shift;
my $class = $self->class_name;
return "Cannot provide traits when $class does not have an init_meta() method";
}
__PACKAGE__->meta->make_immutable;
1;

22
CPAN/Moose/Exception/ClassDoesTheExcludedRole.pm Normal file
View File

@@ -0,0 +1,22 @@
package Moose::Exception::ClassDoesTheExcludedRole;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Role', 'Moose::Exception::Role::Class';
has 'excluded_role_name' => (
is => 'ro',
isa => 'Str',
required => 1
);
sub _build_message {
my $self = shift;
my $excluded_role_name = $self->excluded_role_name;
my $class_name = $self->class_name;
return "The class $class_name does the excluded role '$excluded_role_name'";
}
__PACKAGE__->meta->make_immutable;
1;

25
CPAN/Moose/Exception/ClassNamesDoNotMatch.pm Normal file
View File

@@ -0,0 +1,25 @@
package Moose::Exception::ClassNamesDoNotMatch;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
has class_name => (
is => 'ro',
isa => 'Str',
required => 1,
);
has class => (
is => 'ro',
isa => 'Class::MOP::Class',
required => 1,
);
sub _build_message {
my $self = shift;
"class_name (".$self-> class_name.") does not match class->name (".$self->class->name.")";
}
__PACKAGE__->meta->make_immutable;
1;

20
CPAN/Moose/Exception/CloneObjectExpectsAnInstanceOfMetaclass.pm Normal file
View File

@@ -0,0 +1,20 @@
package Moose::Exception::CloneObjectExpectsAnInstanceOfMetaclass;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::Class';
has 'instance' => (
is => 'ro',
isa => 'Any',
required => 1,
);
sub _build_message {
my $self = shift;
"You must pass an instance of the metaclass (" .$self->class_name. "), not (".$self->instance.")";
}
__PACKAGE__->meta->make_immutable;
1;

13
CPAN/Moose/Exception/CodeBlockMustBeACodeRef.pm Normal file
View File

@@ -0,0 +1,13 @@
package Moose::Exception::CodeBlockMustBeACodeRef;
our $VERSION = '2.2207';
use Moose;
extends 'Moose::Exception';
with 'Moose::Exception::Role::ParamsHash', 'Moose::Exception::Role::Instance';
sub _build_message {
"Your code block must be a CODE reference";
}
__PACKAGE__->meta->make_immutable;
1;

Some files were not shown because too many files have changed in this diff Show More