Commit ebfe7a802271a362b0fcbd84f5364a6eab08b428 - libmoose-perl

+40

-0

Changes less more

0	0	Revision history for Perl extension Moose
	1
	2	0.51 Thurs. Jun 26, 2008
	3	* Moose::Role
	4	- add unimport so "no Moose::Role" actually does
	5	something (sartak)
	6
	7	* Moose::Meta::Role::Application::ToRole
	8	- when RoleA did RoleB, and RoleA aliased a method from RoleB in
	9	order to provide its own implementation, that method still got
	10	added to the list of required methods for consumers of
	11	RoleB. Now an aliased method is only added to the list of
	12	required methods if the role doing the aliasing does not
	13	provide its own implementation. See Recipe 11 for an example
	14	of all this. (Dave Rolsky)
	15	- added tests for this
	16
	17	* Moose::Meta::Method::Constructor
	18	- when a single argument that wasn't a hashref was provided to
	19	an immutabilized constructor, the error message was very
	20	unhelpful, as opposed to the non-immutable error. Reported by
	21	dew. (Dave Rolsky)
	22	- added test for this (Dave Rolsky)
	23
	24	* Moose::Meta::Attribute
	25	- added support for meta_attr->does("ShortAlias") (sartak)
	26	- added tests for this (sartak)
	27	- moved the bulk of the `handles` handling to the new
	28	install_delegation method (Stevan)
	29
	30	* Moose::Object
	31	- Added BUILDARGS, a new step in new()
	32
	33	* Moose::Meta::Role::Application::RoleSummation
	34	- fix typos no one ever sees (sartak)
	35
	36	* Moose::Util::TypeConstraints
	37	* Moose::Meta::TypeConstraint
	38	* Moose::Meta::TypeCoercion
	39	- Attempt to work around the ??{ } vs. threads issue
	40	- Some null_constraint optimizations
1	41
2	42	0.50 Thurs. Jun 11, 2008
3	43	- Fixed a version number issue by bumping all modules

+12

-13

META.yml less more

0		---
1		abstract: A postmodern object system for Perl 5
2		author:
3		- Stevan Little <stevan@iinteractive.com>
4		build_requires:
	0	---
	1	abstract: 'A postmodern object system for Perl 5'
	2	author:
	3	- 'Stevan Little <stevan@iinteractive.com>'
	4	build_requires:
5	5	Test::Exception: 0.21
6	6	Test::LongString: 0
7	7	Test::More: 0.62
8	8	distribution_type: module
9		generated_by: Module::Install version 0.68
	9	generated_by: 'Module::Install version 0.75'
10	10	license: perl
11		meta-spec:
	11	meta-spec:
12	12	url: http://module-build.sourceforge.net/META-spec-v1.3.html
13	13	version: 1.3
14	14	name: Moose
15		no_index:
16		directory:
	15	no_index:
	16	directory:
17	17	- inc
18	18	- t
19		requires:
	19	requires:
20	20	Carp: 0
21		Class::MOP: 0.56
	21	Class::MOP: 0.59
22	22	Filter::Simple: 0
23	23	Scalar::Util: 1.18
24	24	Sub::Exporter: 0.972
25		tests: t/.t t/000_recipes/.t t/010_basics/.t t/020_attributes/.t t/030_roles/.t t/040_type_constraints/.t t/050_metaclasses/.t t/060_compat/.t t/100_bugs/.t t/200_examples/.t t/300_immutable/.t t/400_moose_util/.t t/500_test_moose/*.t
26		version: 0.45
	25	version: 0.51

+1

-1

Makefile.PL less more

0	0	use strict;
1	1	use warnings;
2		use inc::Module::Install;
	2	use inc::Module::Install 0.75;
3	3
4	4	name 'Moose';
5	5	all_from 'lib/Moose.pm';

+1

-1

README less more

0		Moose version 0.50
	0	Moose version 0.51
1	1	===========================
2	2
3	3	See the individual module documentation for more information

+33

-30

lib/Moose/Cookbook/FAQ.pod less more

77	77	If you need to affect the constructor's parameters prior to the
78	78	instance actually being constructed, you have a number of options.
79	79
80		First, there are I<coercions> (See the L<Moose::Cookbook::Recipe5>
81		for a complete example and explaination of coercions). With
82		coercions it is possible to morph argument values into the correct
83		expected types. This approach is the most flexible and robust, but
84		does have a slightly higher learning curve.
85
86		Second, using an C<around> method modifier on C<new> can be an
87		effective way to affect the contents of C<@_> prior to letting
88		Moose deal with it. This carries with it the extra burden for
89		your subclasses, in that they have to be sure to explicitly
90		call your C<new> and/or work around your C<new> to get to the
91		version from L<Moose::Object>.
92
93		The last approach is to use the standard Perl technique of calling
94		the C<SUPER::new> within your own custom version of C<new>. This,
95		of course, brings with it all the issues of the C<around> solution
96		as well as any issues C<SUPER::> might add.
97
98		In short, try to use C<BUILD> and coercions, they are your best
99		bets.
	80	To change the parameter processing as a whole, you can use
	81	the C<BUILDARGS> method. The default implementation accepts key/value
	82	pairs or a hash reference. You can override it to take positional args,
	83	or any other format
	84
	85	To change the handling of individual parameters, there are I<coercions>
	86	(See the L<Moose::Cookbook::Recipe5> for a complete example and
	87	explaination of coercions). With coercions it is possible to morph
	88	argument values into the correct expected types. This approach is the
	89	most flexible and robust, but does have a slightly higher learning
	90	curve.
100	91
101	92	=head3 How do I make non-Moose constructors work with Moose?
102	93
103		Moose provides its own constructor, but it does it by making all
104		Moose-based classes inherit from L<Moose::Object>. When inheriting
105		from a non-Moose class, the inheritance chain to L<Moose::Object>
106		is broken. The simplest way to fix this is to simply explicitly
107		inherit from L<Moose::Object> yourself. However, this does not
108		always fix the issue of a constructor. Here is a basic example of
109		how this can be worked around:
	94	Usually the correct approach to subclassing a non Moose class is
	95	delegation. Moose makes this easy using the C<handles> keyword,
	96	coercions, and C<lazy_build>, so subclassing is often not the
	97	ideal route.
	98
	99	That said, the default Moose constructors is inherited from
	100	L<Moose::Object>. When inheriting from a non-Moose class, the
	101	inheritance chain to L<Moose::Object> is broken. The simplest way
	102	to fix this is to simply explicitly inherit from L<Moose::Object>
	103	yourself.
	104
	105	However, this does not always fix the issue of actually calling the Moose
	106	constructor. Fortunately L<Class::MOP::Class/new_object>, the low level
	107	constructor, accepts the special C<__INSTANCE__> parameter, allowing you to
	108	instantiate your Moose attributes:
110	109
111	110	package My::HTML::Template;
112	111	use Moose;

122	121	return $class->meta->new_object(
123	122	# pass in the constructed object
124	123	# using the special key __INSTANCE__
125		__INSTANCE__ => $obj, @_
	124	__INSTANCE__ => $obj,
	125	@_, # pass in the normal args
126	126	);
127	127	}
128	128
129	129	Of course, this only works if both your Moose class and the
130	130	inherited non-Moose class use the same instance type (typically
131		HASH refs).
	131	HASH refs).
	132
	133	Note that this doesn't call C<BUILDALL> automatically, you must do that
	134	yourself.
132	135
133	136	Other techniques can be used as well, such as creating the object
134	137	using C<Moose::Object::new>, but calling the inherited non-Moose

291	294	This library is free software; you can redistribute it and/or modify
292	295	it under the same terms as Perl itself.
293	296
294		=cut⏎
	297	=cut

+1

-1

lib/Moose/Cookbook/Recipe11.pod less more

11	11
12	12	has 'is_paused' => (
13	13	is => 'rw',
14		isa => 'Boo',
	14	isa => 'Bool',
15	15	default => 0,
16	16	);
17	17

+78

-72

lib/Moose/Meta/Attribute.pm less more

7	7	use Carp 'confess';
8	8	use overload ();
9	9
10		our $VERSION = '0.50';
	10	our $VERSION = '0.51';
11	11	our $AUTHORITY = 'cpan:STEVAN';
12	12
13	13	use Moose::Meta::Method::Accessor;

50	50	predicate => 'has_applied_traits',
51	51	));
52	52
53		# NOTE:
54	53	# we need to have a ->does method in here to
55	54	# more easily support traits, and the introspection
56		# of those traits. So in order to do this we
57		# just alias Moose::Object's version of it.
58		# - SL
59		*does = \&Moose::Object::does;
	55	# of those traits. We extend the does check to look
	56	# for metatrait aliases.
	57	sub does {
	58	my ($self, $role_name) = @_;
	59	my $name = eval {
	60	Moose::Util::resolve_metatrait_alias(Attribute => $role_name)
	61	};
	62	return 0 if !defined($name); # failed to load class
	63	return Moose::Object::does($self, $name);
	64	}
60	65
61	66	sub new {
62	67	my ($class, $name, %options) = @_;

207	212
208	213	if (exists $options->{is}) {
209	214
210		=pod
211
212		is => ro, writer => _foo # turns into (reader => foo, writer => _foo) as before
213		is => rw, writer => _foo # turns into (reader => foo, writer => _foo)
214		is => rw, accessor => _foo # turns into (accessor => _foo)
215		is => ro, accessor => _foo # error, accesor is rw
216
217		=cut
	215	### -------------------------
	216	## is => ro, writer => _foo # turns into (reader => foo, writer => _foo) as before
	217	## is => rw, writer => _foo # turns into (reader => foo, writer => _foo)
	218	## is => rw, accessor => _foo # turns into (accessor => _foo)
	219	## is => ro, accessor => _foo # error, accesor is rw
	220	### -------------------------
218	221
219	222	if ($options->{is} eq 'ro') {
220	223	confess "Cannot define an accessor name on a read-only attribute, accessors are read/write"

502	505	sub install_accessors {
503	506	my $self = shift;
504	507	$self->SUPER::install_accessors(@_);
505
506		if ($self->has_handles) {
	508	$self->install_delegation if $self->has_handles;
	509	return;
	510	}
	511
	512	sub install_delegation {
	513	my $self = shift;
	514
	515	# NOTE:
	516	# Here we canonicalize the 'handles' option
	517	# this will sort out any details and always
	518	# return an hash of methods which we want
	519	# to delagate to, see that method for details
	520	my %handles = $self->_canonicalize_handles();
	521
	522	# find the accessor method for this attribute
	523	my $accessor = $self->get_read_method_ref;
	524	# then unpack it if we need too ...
	525	$accessor = $accessor->body if blessed $accessor;
	526
	527	# install the delegation ...
	528	my $associated_class = $self->associated_class;
	529	foreach my $handle (keys %handles) {
	530	my $method_to_call = $handles{$handle};
	531	my $class_name = $associated_class->name;
	532	my $name = "${class_name}::${handle}";
	533
	534	(!$associated_class->has_method($handle))
	535	\|\| confess "You cannot overwrite a locally defined method ($handle) with a delegation";
507	536
508	537	# NOTE:
509		# Here we canonicalize the 'handles' option
510		# this will sort out any details and always
511		# return an hash of methods which we want
512		# to delagate to, see that method for details
513		my %handles = $self->_canonicalize_handles();
514
515		# find the accessor method for this attribute
516		my $accessor = $self->get_read_method_ref;
517		# then unpack it if we need too ...
518		$accessor = $accessor->body if blessed $accessor;
519
520		# install the delegation ...
521		my $associated_class = $self->associated_class;
522		foreach my $handle (keys %handles) {
523		my $method_to_call = $handles{$handle};
524		my $class_name = $associated_class->name;
525		my $name = "${class_name}::${handle}";
526
527		(!$associated_class->has_method($handle))
528		\|\| confess "You cannot overwrite a locally defined method ($handle) with a delegation";
529
	538	# handles is not allowed to delegate
	539	# any of these methods, as they will
	540	# override the ones in your class, which
	541	# is almost certainly not what you want.
	542
	543	# FIXME warn when $handle was explicitly specified, but not if the source is a regex or something
	544	#cluck("Not delegating method '$handle' because it is a core method") and
	545	next if $class_name->isa("Moose::Object") and $handle =~ /^BUILD\|DEMOLISH$/ \|\| Moose::Object->can($handle);
	546
	547	if ('CODE' eq ref($method_to_call)) {
	548	$associated_class->add_method($handle => Class::MOP::subname($name, $method_to_call));
	549	}
	550	else {
530	551	# NOTE:
531		# handles is not allowed to delegate
532		# any of these methods, as they will
533		# override the ones in your class, which
534		# is almost certainly not what you want.
535
536		# FIXME warn when $handle was explicitly specified, but not if the source is a regex or something
537		#cluck("Not delegating method '$handle' because it is a core method") and
538		next if $class_name->isa("Moose::Object") and $handle =~ /^BUILD\|DEMOLISH$/ \|\| Moose::Object->can($handle);
539
540		if ('CODE' eq ref($method_to_call)) {
541		$associated_class->add_method($handle => Class::MOP::subname($name, $method_to_call));
542		}
543		else {
544		# NOTE:
545		# we used to do a goto here, but the
546		# goto didn't handle failure correctly
547		# (it just returned nothing), so I took
548		# that out. However, the more I thought
549		# about it, the less I liked it doing
550		# the goto, and I prefered the act of
551		# delegation being actually represented
552		# in the stack trace.
553		# - SL
554		$associated_class->add_method($handle => Class::MOP::subname($name, sub {
555		my $proxy = (shift)->$accessor();
556		(defined $proxy)
557		\|\| confess "Cannot delegate $handle to $method_to_call because " .
558		"the value of " . $self->name . " is not defined";
559		$proxy->$method_to_call(@_);
560		}));
561		}
562		}
563		}
564
565		return;
	552	# we used to do a goto here, but the
	553	# goto didn't handle failure correctly
	554	# (it just returned nothing), so I took
	555	# that out. However, the more I thought
	556	# about it, the less I liked it doing
	557	# the goto, and I prefered the act of
	558	# delegation being actually represented
	559	# in the stack trace.
	560	# - SL
	561	$associated_class->add_method($handle => Class::MOP::subname($name, sub {
	562	my $proxy = (shift)->$accessor();
	563	(defined $proxy)
	564	\|\| confess "Cannot delegate $handle to $method_to_call because " .
	565	"the value of " . $self->name . " is not defined";
	566	$proxy->$method_to_call(@_);
	567	}));
	568	}
	569	}
566	570	}
567	571
568	572	# private methods to help delegation ...

687	691
688	692	=item B<install_accessors>
689	693
	694	=item B<install_delegation>
	695
690	696	=item B<accessor_metaclass>
691	697
692	698	=item B<get_value>

+1

-1

lib/Moose/Meta/Class.pm less more

8	8	use Carp 'confess';
9	9	use Scalar::Util 'weaken', 'blessed';
10	10
11		our $VERSION = '0.50';
	11	our $VERSION = '0.51';
12	12	our $AUTHORITY = 'cpan:STEVAN';
13	13
14	14	use Moose::Meta::Method::Overriden;

+1

-1

lib/Moose/Meta/Instance.pm less more

3	3	use strict;
4	4	use warnings;
5	5
6		our $VERSION = '0.50';
	6	our $VERSION = '0.51';
7	7	our $AUTHORITY = 'cpan:STEVAN';
8	8
9	9	use base "Class::MOP::Instance";

+1

-1

lib/Moose/Meta/Method/Accessor.pm less more

5	5
6	6	use Carp 'confess';
7	7
8		our $VERSION = '0.50';
	8	our $VERSION = '0.51';
9	9	our $AUTHORITY = 'cpan:STEVAN';
10	10
11	11	use base 'Moose::Meta::Method',

+1

-1

lib/Moose/Meta/Method/Augmented.pm less more

4	4
5	5	use Carp 'confess';
6	6
7		our $VERSION = '0.50';
	7	our $VERSION = '0.51';
8	8	our $AUTHORITY = 'cpan:STEVAN';
9	9
10	10	use base 'Moose::Meta::Method';

+32

-13

lib/Moose/Meta/Method/Constructor.pm less more

6	6	use Carp 'confess';
7	7	use Scalar::Util 'blessed', 'weaken', 'looks_like_number';
8	8
9		our $VERSION = '0.50';
	9	our $VERSION = '0.51';
10	10	our $AUTHORITY = 'cpan:STEVAN';
11	11
12	12	use base 'Moose::Meta::Method',

74	74	$source .= "\n" . 'return $class->Moose::Object::new(@_)';
75	75	$source .= "\n" . ' if $class ne \'' . $self->associated_metaclass->name . '\';';
76	76
77		$source .= "\n" . 'my %params = (scalar @_ == 1) ? %{$_[0]} : @_;';
78
79		$source .= "\n" . 'my $instance = ' . $self->meta_instance->inline_create_instance('$class');
	77	$source .= "\n" . 'my $params = ' . $self->_generate_BUILDARGS('$class', '@_');
	78
	79	$source .= ";\n" . 'my $instance = ' . $self->meta_instance->inline_create_instance('$class');
80	80
81	81	$source .= ";\n" . (join ";\n" => map {
82	82	$self->_generate_slot_initializer($_)

119	119	$self->{'&!body'} = $code;
120	120	}
121	121
	122	sub _generate_BUILDARGS {
	123	my ( $self, $class, $args ) = @_;
	124
	125	my $buildargs = $self->associated_metaclass->find_method_by_name("BUILDARGS");
	126
	127	if ( $args eq '@_' and ( !$buildargs or $buildargs->body == \&Moose::Object::BUILDARGS ) ) {
	128	return join("\n",
	129	'do {',
	130	'no warnings "uninitialized";',
	131	'confess "Single parameters to new() must be a HASH ref"',
	132	' if scalar @_ == 1 && defined $_[0] && ref($_[0]) ne q{HASH};',
	133	'(scalar @_ == 1) ? {%{$_[0]}} : {@_};',
	134	'}',
	135	);
	136	} else {
	137	return $class . "->BUILDARGS($args)";
	138	}
	139	}
	140
122	141	sub _generate_BUILDALL {
123	142	my $self = shift;
124	143	my @BUILD_calls;
125	144	foreach my $method (reverse $self->associated_metaclass->find_all_methods_by_name('BUILD')) {
126		push @BUILD_calls => '$instance->' . $method->{class} . '::BUILD(\%params)';
	145	push @BUILD_calls => '$instance->' . $method->{class} . '::BUILD($params)';
127	146	}
128	147	return join ";\n" => @BUILD_calls;
129	148	}

136	155	if ($attr->can('has_trigger') && $attr->has_trigger) {
137	156	if (defined(my $init_arg = $attr->init_arg)) {
138	157	push @trigger_calls => (
139		'(exists $params{\'' . $init_arg . '\'}) && do {' . "\n "
	158	'(exists $params->{\'' . $init_arg . '\'}) && do {' . "\n "
140	159	. '$attrs->[' . $i . ']->trigger->('
141	160	. '$instance, '
142	161	. $self->meta_instance->inline_get_slot_value(

165	184	my $is_moose = $attr->isa('Moose::Meta::Attribute'); # XXX FIXME
166	185
167	186	if ($is_moose && defined($attr->init_arg) && $attr->is_required && !$attr->has_default && !$attr->has_builder) {
168		push @source => ('(exists $params{\'' . $attr->init_arg . '\'}) ' .
	187	push @source => ('(exists $params->{\'' . $attr->init_arg . '\'}) ' .
169	188	'\|\| confess "Attribute (' . $attr->name . ') is required";');
170	189	}
171	190
172	191	if (($attr->has_default \|\| $attr->has_builder) && !($is_moose && $attr->is_lazy)) {
173	192
174	193	if ( defined( my $init_arg = $attr->init_arg ) ) {
175		push @source => 'if (exists $params{\'' . $init_arg . '\'}) {';
176
177		push @source => ('my $val = $params{\'' . $init_arg . '\'};');
	194	push @source => 'if (exists $params->{\'' . $init_arg . '\'}) {';
	195
	196	push @source => ('my $val = $params->{\'' . $init_arg . '\'};');
178	197
179	198	if ($is_moose && $attr->has_type_constraint) {
180	199	if ($attr->should_coerce && $attr->type_constraint->has_coercion) {

220	239	push @source => "}" if defined $attr->init_arg;
221	240	}
222	241	elsif ( defined( my $init_arg = $attr->init_arg ) ) {
223		push @source => '(exists $params{\'' . $init_arg . '\'}) && do {';
224
225		push @source => ('my $val = $params{\'' . $init_arg . '\'};');
	242	push @source => '(exists $params->{\'' . $init_arg . '\'}) && do {';
	243
	244	push @source => ('my $val = $params->{\'' . $init_arg . '\'};');
226	245	if ($is_moose && $attr->has_type_constraint) {
227	246	if ($attr->should_coerce && $attr->type_constraint->has_coercion) {
228	247	push @source => $self->_generate_type_coercion(

+1

-1

lib/Moose/Meta/Method/Destructor.pm less more

6	6	use Carp 'confess';
7	7	use Scalar::Util 'blessed', 'weaken';
8	8
9		our $VERSION = '0.50';
	9	our $VERSION = '0.51';
10	10	our $AUTHORITY = 'cpan:STEVAN';
11	11
12	12	use base 'Moose::Meta::Method',

+1

-1

lib/Moose/Meta/Method/Overriden.pm less more

4	4
5	5	use Carp 'confess';
6	6
7		our $VERSION = '0.50';
	7	our $VERSION = '0.51';
8	8	our $AUTHORITY = 'cpan:STEVAN';
9	9
10	10	use base 'Moose::Meta::Method';

+2

-2

lib/Moose/Meta/Method.pm less more

2	2	use strict;
3	3	use warnings;
4	4
5		our $VERSION = '0.50';
	5	our $VERSION = '0.51';
6	6	our $AUTHORITY = 'cpan:STEVAN';
7	7
8	8	use base 'Class::MOP::Method';

42	42	This library is free software; you can redistribute it and/or modify
43	43	it under the same terms as Perl itself.
44	44
45		=cut⏎
	45	=cut

+2

-2

lib/Moose/Meta/Role/Application/RoleSummation.pm less more

9	9
10	10	use Moose::Meta::Role::Composite;
11	11
12		our $VERSION = '0.50';
	12	our $VERSION = '0.51';
13	13	our $AUTHORITY = 'cpan:STEVAN';
14	14
15	15	use base 'Moose::Meta::Role::Application';

118	118	my %seen;
119	119	foreach my $attr (@all_attributes) {
120	120	if (exists $seen{$attr->{name}}) {
121		confess "We have encountered an attribute conflict with '" . $attr->{name} . "'"
	121	confess "We have encountered an attribute conflict with '" . $attr->{name} . "' "
122	122	. "during composition. This is fatal error and cannot be disambiguated."
123	123	if $seen{$attr->{name}} != $attr->{attr};
124	124	}

+1

-1

lib/Moose/Meta/Role/Application/ToClass.pm less more

8	8
9	9	use Data::Dumper;
10	10
11		our $VERSION = '0.50';
	11	our $VERSION = '0.51';
12	12	our $AUTHORITY = 'cpan:STEVAN';
13	13
14	14	use base 'Moose::Meta::Role::Application';

+1

-1

lib/Moose/Meta/Role/Application/ToInstance.pm less more

6	6	use Carp 'confess';
7	7	use Scalar::Util 'blessed';
8	8
9		our $VERSION = '0.50';
	9	our $VERSION = '0.51';
10	10	our $AUTHORITY = 'cpan:STEVAN';
11	11
12	12	use base 'Moose::Meta::Role::Application::ToClass';

+22

-14

lib/Moose/Meta/Role/Application/ToRole.pm less more

8	8
9	9	use Data::Dumper;
10	10
11		our $VERSION = '0.50';
	11	our $VERSION = '0.51';
12	12	our $AUTHORITY = 'cpan:STEVAN';
13	13
14	14	use base 'Moose::Meta::Role::Application';

69	69	foreach my $method_name ($role1->get_method_list) {
70	70
71	71	next if $self->is_method_excluded($method_name);
	72
	73	if ($self->is_method_aliased($method_name)) {
	74	my $aliased_method_name = $self->get_method_aliases->{$method_name};
	75	# it if it has one already
	76	if ($role2->has_method($aliased_method_name) &&
	77	# and if they are not the same thing ...
	78	$role2->get_method($aliased_method_name)->body != $role1->get_method($method_name)->body) {
	79	confess "Cannot create a method alias if a local method of the same name exists";
	80	}
	81
	82	$role2->alias_method(
	83	$aliased_method_name,
	84	$role1->get_method($method_name)
	85	);
	86
	87	if (!$role2->has_method($method_name)) {
	88	$role2->add_required_methods($method_name);
	89	}
	90
	91	next;
	92	}
72	93
73	94	# it if it has one already
74	95	if ($role2->has_method($method_name) &&

87	108
88	109	}
89	110
90		if ($self->is_method_aliased($method_name)) {
91		my $aliased_method_name = $self->get_method_aliases->{$method_name};
92		# it if it has one already
93		if ($role2->has_method($aliased_method_name) &&
94		# and if they are not the same thing ...
95		$role2->get_method($aliased_method_name)->body != $role1->get_method($method_name)->body) {
96		confess "Cannot create a method alias if a local method of the same name exists";
97		}
98		$role2->alias_method(
99		$aliased_method_name,
100		$role1->get_method($method_name)
101		);
102		}
103	111	}
104	112	}
105	113

+1

-1

lib/Moose/Meta/Role/Application.pm less more

3	3	use warnings;
4	4	use metaclass;
5	5
6		our $VERSION = '0.50';
	6	our $VERSION = '0.51';
7	7	our $AUTHORITY = 'cpan:STEVAN';
8	8
9	9	__PACKAGE__->meta->add_attribute('method_exclusions' => (

+2

-2

lib/Moose/Meta/Role/Composite.pm less more

6	6	use Carp 'confess';
7	7	use Scalar::Util 'blessed';
8	8
9		our $VERSION = '0.50';
	9	our $VERSION = '0.51';
10	10	our $AUTHORITY = 'cpan:STEVAN';
11	11
12	12	use base 'Moose::Meta::Role';

109	109	This library is free software; you can redistribute it and/or modify
110	110	it under the same terms as Perl itself.
111	111
112		=cut⏎
	112	=cut

+2

-2

lib/Moose/Meta/Role/Method/Required.pm less more

3	3	use strict;
4	4	use warnings;
5	5
6		our $VERSION = '0.50';
	6	our $VERSION = '0.51';
7	7	our $AUTHORITY = 'cpan:STEVAN';
8	8
9	9	use base 'Moose::Meta::Role::Method';

39	39	This library is free software; you can redistribute it and/or modify
40	40	it under the same terms as Perl itself.
41	41
42		=cut⏎
	42	=cut

+2

-2

lib/Moose/Meta/Role/Method.pm less more

3	3	use strict;
4	4	use warnings;
5	5
6		our $VERSION = '0.50';
	6	our $VERSION = '0.51';
7	7	our $AUTHORITY = 'cpan:STEVAN';
8	8
9	9	use base 'Class::MOP::Method';

43	43	This library is free software; you can redistribute it and/or modify
44	44	it under the same terms as Perl itself.
45	45
46		=cut⏎
	46	=cut

+1

-1

lib/Moose/Meta/Role.pm less more

7	7	use Carp 'confess';
8	8	use Scalar::Util 'blessed';
9	9
10		our $VERSION = '0.50';
	10	our $VERSION = '0.51';
11	11	our $AUTHORITY = 'cpan:STEVAN';
12	12
13	13	use Moose::Meta::Class;

+2

-2

lib/Moose/Meta/TypeCoercion/Union.pm less more

7	7	use Carp 'confess';
8	8	use Scalar::Util 'blessed';
9	9
10		our $VERSION = '0.50';
	10	our $VERSION = '0.51';
11	11	our $AUTHORITY = 'cpan:STEVAN';
12	12
13	13	use base 'Moose::Meta::TypeCoercion';

99	99	This library is free software; you can redistribute it and/or modify
100	100	it under the same terms as Perl itself.
101	101
102		=cut⏎
	102	=cut

+1

-1

lib/Moose/Meta/TypeCoercion.pm less more

9	9	use Moose::Meta::Attribute;
10	10	use Moose::Util::TypeConstraints ();
11	11
12		our $VERSION = '0.50';
	12	our $VERSION = '0.51';
13	13	our $AUTHORITY = 'cpan:STEVAN';
14	14
15	15	__PACKAGE__->meta->add_attribute('type_coercion_map' => (

+1

-1

lib/Moose/Meta/TypeConstraint/Class.pm less more

6	6	use Scalar::Util 'blessed';
7	7	use Moose::Util::TypeConstraints ();
8	8
9		our $VERSION = '0.50';
	9	our $VERSION = '0.51';
10	10	our $AUTHORITY = 'cpan:STEVAN';
11	11
12	12	use base 'Moose::Meta::TypeConstraint';

+1

-1

lib/Moose/Meta/TypeConstraint/Enum.pm less more

5	5
6	6	use Moose::Util::TypeConstraints ();
7	7
8		our $VERSION = '0.50';
	8	our $VERSION = '0.51';
9	9	our $AUTHORITY = 'cpan:STEVAN';
10	10
11	11	use base 'Moose::Meta::TypeConstraint';

+1

-1

lib/Moose/Meta/TypeConstraint/Parameterizable.pm less more

3	3	use warnings;
4	4	use metaclass;
5	5
6		our $VERSION = '0.50';
	6	our $VERSION = '0.51';
7	7	our $AUTHORITY = 'cpan:STEVAN';
8	8
9	9	use base 'Moose::Meta::TypeConstraint';

+1

-1

lib/Moose/Meta/TypeConstraint/Parameterized.pm less more

7	7	use Carp 'confess';
8	8	use Moose::Util::TypeConstraints;
9	9
10		our $VERSION = '0.50';
	10	our $VERSION = '0.51';
11	11	our $AUTHORITY = 'cpan:STEVAN';
12	12
13	13	use base 'Moose::Meta::TypeConstraint';

+1

-1

lib/Moose/Meta/TypeConstraint/Registry.pm less more

7	7	use Scalar::Util 'blessed';
8	8	use Carp 'confess';
9	9
10		our $VERSION = '0.50';
	10	our $VERSION = '0.51';
11	11	our $AUTHORITY = 'cpan:STEVAN';
12	12
13	13	use base 'Class::MOP::Object';

+1

-1

lib/Moose/Meta/TypeConstraint/Role.pm less more

6	6	use Scalar::Util 'blessed';
7	7	use Moose::Util::TypeConstraints ();
8	8
9		our $VERSION = '0.50';
	9	our $VERSION = '0.51';
10	10	our $AUTHORITY = 'cpan:STEVAN';
11	11
12	12	use base 'Moose::Meta::TypeConstraint';

+1

-1

lib/Moose/Meta/TypeConstraint/Union.pm less more

6	6
7	7	use Moose::Meta::TypeCoercion::Union;
8	8
9		our $VERSION = '0.50';
	9	our $VERSION = '0.51';
10	10	our $AUTHORITY = 'cpan:STEVAN';
11	11
12	12	use base 'Moose::Meta::TypeConstraint';

+46

-22

lib/Moose/Meta/TypeConstraint.pm less more

10	10	use Carp 'confess';
11	11	use Scalar::Util qw(blessed refaddr);
12	12
13		our $VERSION = '0.50';
	13	our $VERSION = '0.51';
14	14	our $AUTHORITY = 'cpan:STEVAN';
15	15
16	16	__PACKAGE__->meta->add_attribute('name' => (reader => 'name'));

18	18	reader => 'parent',
19	19	predicate => 'has_parent',
20	20	));
	21
	22	my $null_constraint = sub { 1 };
21	23	__PACKAGE__->meta->add_attribute('constraint' => (
22	24	reader => 'constraint',
23	25	writer => '_set_constraint',
24		default => sub { sub { 1 } }
	26	default => sub { $null_constraint }
25	27	));
26	28	__PACKAGE__->meta->add_attribute('message' => (
27	29	accessor => 'message',

172	174	sub _compile_subtype {
173	175	my ($self, $check) = @_;
174	176
175		# so we gather all the parents in order
176		# and grab their constraints ...
	177	# gather all the parent constraintss in order
177	178	my @parents;
	179	my $optimized_parent;
178	180	foreach my $parent ($self->_collect_all_parents) {
	181	# if a parent is optimized, the optimized constraint already includes
	182	# all of its parents tcs, so we can break the loop
179	183	if ($parent->has_hand_optimized_type_constraint) {
180		unshift @parents => $parent->hand_optimized_type_constraint;
	184	push @parents => $optimized_parent = $parent->hand_optimized_type_constraint;
181	185	last;
182	186	}
183	187	else {
184		unshift @parents => $parent->constraint;
	188	push @parents => $parent->constraint;
185	189	}
186	190	}
187	191
188		# then we compile them to run without
189		# having to recurse as we did before
	192	@parents = grep { $_ != $null_constraint } reverse @parents;
	193
	194	unless ( @parents ) {
	195	return $self->_compile_type($check);
	196	} elsif( $optimized_parent and @parents == 1 ) {
	197	# the case of just one optimized parent is optimized to prevent
	198	# looping and the unnecessary localization
	199	if ( $check == $null_constraint ) {
	200	return $optimized_parent;
	201	} else {
	202	return Class::MOP::subname($self->name, sub {
	203	return undef unless $optimized_parent->($_[0]);
	204	local $_ = $_[0];
	205	$check->($_[0]);
	206	});
	207	}
	208	} else {
	209	# general case, check all the constraints, from the first parent to ourselves
	210	my @checks = @parents;
	211	push @checks, $check if $check != $null_constraint;
	212	return Class::MOP::subname($self->name => sub {
	213	local $_ = $_[0];
	214	foreach my $check (@checks) {
	215	return undef unless $check->($_[0]);
	216	}
	217	return 1;
	218	});
	219	}
	220	}
	221
	222	sub _compile_type {
	223	my ($self, $check) = @_;
	224
	225	return $check if $check == $null_constraint; # Item, Any
	226
190	227	return Class::MOP::subname($self->name => sub {
191	228	local $_ = $_[0];
192		foreach my $parent (@parents) {
193		return undef unless $parent->($_[0]);
194		}
195		return undef unless $check->($_[0]);
196		1;
197		});
198		}
199
200		sub _compile_type {
201		my ($self, $check) = @_;
202		return Class::MOP::subname($self->name => sub {
203		local $_ = $_[0];
204		return undef unless $check->($_[0]);
205		1;
	229	$check->($_[0]);
206	230	});
207	231	}
208	232

+23

-11

lib/Moose/Object.pm less more

8	8
9	9	use Carp 'confess';
10	10
11		our $VERSION = '0.50';
	11	our $VERSION = '0.51';
12	12	our $AUTHORITY = 'cpan:STEVAN';
13	13
14	14	sub new {
15	15	my $class = shift;
16		my %params;
	16	my $params = $class->BUILDARGS(@_);
	17	my $self = $class->meta->new_object(%$params);
	18	$self->BUILDALL($params);
	19	return $self;
	20	}
	21
	22	sub BUILDARGS {
	23	my $class = shift;
	24
17	25	if (scalar @_ == 1) {
18	26	if (defined $_[0]) {
	27	no warnings 'uninitialized';
19	28	(ref($_[0]) eq 'HASH')
20	29	\|\| confess "Single parameters to new() must be a HASH ref";
21		%params = %{$_[0]};
	30	return {%{$_[0]}};
	31	} else {
	32	return {}; # FIXME this is compat behavior, but is it correct?
22	33	}
	34	} else {
	35	return {@_};
23	36	}
24		else {
25		%params = @_;
26		}
27		my $self = $class->meta->new_object(%params);
28		$self->BUILDALL(\%params);
29		return $self;
30	37	}
31	38
32	39	sub BUILDALL {

70	77	sub does {
71	78	my ($self, $role_name) = @_;
72	79	(defined $role_name)
73		\|\| confess "You much supply a role name to does()";
	80	\|\| confess "You must supply a role name to does()";
74	81	my $meta = $self->meta;
75	82	foreach my $class ($meta->class_precedence_list) {
76	83	my $m = $meta->initialize($class);

127	134
128	135	=item B<new>
129	136
130		This will create a new instance and call C<BUILDALL>.
	137	This will call C<BUILDARGS>, create a new instance and call C<BUILDALL>.
	138
	139	=item B<BUILDARGS>
	140
	141	This method processes an argument list into a hash reference. It is used by
	142	C<new>.
131	143
132	144	=item B<BUILDALL>
133	145

+28

-2

lib/Moose/Role.pm less more

9	9	use Data::OptList;
10	10	use Sub::Exporter;
11	11
12		our $VERSION = '0.50';
	12	our $VERSION = '0.51';
13	13	our $AUTHORITY = 'cpan:STEVAN';
14	14
15	15	use Moose ();

48	48	extends => sub {
49	49	my $meta = _find_meta();
50	50	return Class::MOP::subname('Moose::Role::extends' => sub {
51		croak "Moose::Role does not currently support 'extends'"
	51	croak "Roles do not currently support 'extends'"
52	52	});
53	53	},
54	54	with => sub {

181	181	goto $exporter;
182	182	};
183	183
	184	sub unimport {
	185	no strict 'refs';
	186	my $class = Moose::_get_caller(@_);
	187
	188	# loop through the exports ...
	189	foreach my $name ( keys %exports ) {
	190
	191	# if we find one ...
	192	if ( defined &{ $class . '::' . $name } ) {
	193	my $keyword = \&{ $class . '::' . $name };
	194
	195	# make sure it is from Moose::Role
	196	my ($pkg_name) = Class::MOP::get_code_info($keyword);
	197	next if $pkg_name ne 'Moose::Role';
	198
	199	# and if it is from Moose::Role then undef the slot
	200	delete ${ $class . '::' }{$name};
	201	}
	202	}
	203	}
184	204	}
185	205
186	206	1;

249	269	lightly.
250	270
251	271	=back
	272
	273	=head2 B<unimport>
	274
	275	Moose::Role offers a way to remove the keywords it exports, through the
	276	C<unimport> method. You simply have to say C<no Moose::Role> at the bottom of
	277	your code for this to work.
252	278
253	279	=head1 CAVEATS
254	280

+1

-1

lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm less more

4	4
5	5	use Scalar::Util 'blessed', 'looks_like_number';
6	6
7		our $VERSION = '0.50';
	7	our $VERSION = '0.51';
8	8	our $AUTHORITY = 'cpan:STEVAN';
9	9
10	10	sub Value { defined($_[0]) && !ref($_[0]) }

+9

-3

lib/Moose/Util/TypeConstraints.pm less more

7	7	use Scalar::Util 'blessed';
8	8	use Sub::Exporter;
9	9
10		our $VERSION = '0.50';
	10	our $VERSION = '0.51';
11	11	our $AUTHORITY = 'cpan:STEVAN';
12	12
13	13	## --------------------------------------------------------

107	107	no strict 'refs';
108	108	foreach my $constraint (keys %{$REGISTRY->type_constraints}) {
109	109	my $tc = $REGISTRY->get_type_constraint($constraint)->_compiled_type_constraint;
110		*{"${pkg}::${constraint}"} = sub { $tc->($_[0]) ? 1 : undef };
	110	*{"${pkg}::${constraint}"} = sub { $tc->($_[0]) ? 1 : undef }; # the undef is for compat
111	111	}
112	112	}
113	113

454	454	my $valid_chars = qr{[\w:]};
455	455	my $type_atom = qr{ $valid_chars+ };
456	456
	457	my $any;
	458
457	459	my $type = qr{ $valid_chars+ (?: \[ (??{$any}) \] )? }x;
458	460	my $type_capture_parts = qr{ ($valid_chars+) (?: \[ ((??{$any})) \] )? }x;
459	461	my $type_with_parameter = qr{ $valid_chars+ \[ (??{$any}) \] }x;

461	463	my $op_union = qr{ \s* \\| \s* }x;
462	464	my $union = qr{ $type (?: $op_union $type )+ }x;
463	465
464		our $any = qr{ $type \| $union }x;
	466	$any = qr{ $type \| $union }x;
465	467
466	468	sub _parse_parameterized_type_constraint {
	469	{ no warnings 'void'; $any; } # force capture of interpolated lexical
467	470	$_[0] =~ m{ $type_capture_parts }x;
468	471	return ($1, $2);
469	472	}
470	473
471	474	sub _detect_parameterized_type_constraint {
	475	{ no warnings 'void'; $any; } # force capture of interpolated lexical
472	476	$_[0] =~ m{ ^ $type_with_parameter $ }x;
473	477	}
474	478
475	479	sub _parse_type_constraint_union {
	480	{ no warnings 'void'; $any; } # force capture of interpolated lexical
476	481	my $given = shift;
477	482	my @rv;
478	483	while ( $given =~ m{ \G (?: $op_union )? ($type) }gcx ) {

488	493	}
489	494
490	495	sub _detect_type_constraint_union {
	496	{ no warnings 'void'; $any; } # force capture of interpolated lexical
491	497	$_[0] =~ m{^ $type $op_union $type ( $op_union .* )? $}x;
492	498	}
493	499	}

+1

-1

lib/Moose/Util.pm less more

7	7	use Carp 'confess';
8	8	use Class::MOP 0.56;
9	9
10		our $VERSION = '0.50';
	10	our $VERSION = '0.51';
11	11	our $AUTHORITY = 'cpan:STEVAN';
12	12
13	13	my @exports = qw[

+1

-1

lib/Moose.pm less more

3	3	use strict;
4	4	use warnings;
5	5
6		our $VERSION = '0.50';
	6	our $VERSION = '0.51';
7	7	our $AUTHORITY = 'cpan:STEVAN';
8	8
9	9	use Scalar::Util 'blessed';

+1

-1

lib/Test/Moose.pm less more

7	7
8	8	use Moose::Util 'does_role', 'find_meta';
9	9
10		our $VERSION = '0.50';
	10	our $VERSION = '0.51';
11	11	our $AUTHORITY = 'cpan:STEVAN';
12	12
13	13	my @exports = qw[

+1

-1

lib/oose.pm less more

4	4
5	5	use Class::MOP;
6	6
7		our $VERSION = '0.50';
	7	our $VERSION = '0.51';
8	8	our $AUTHORITY = 'cpan:STEVAN';
9	9
10	10	BEGIN {

+13

-13

t/000_recipes/011_advanced_role_composition.t less more

0	0	use strict;
1	1	use warnings;
2		use Test::More skip_all => 'not working yet';
	2	use Test::More tests => 5;
3	3	use Class::MOP;
4	4
5		# follow is original code
	5	# This is copied directly from recipe 11
6	6	{
7	7	package Restartable;
8	8	use Moose::Role;
9	9
10	10	has 'is_paused' => (
11	11	is => 'rw',
12		isa => 'Boo',
	12	isa => 'Bool',
13	13	default => 0,
14	14	);
15	15

63	63	}
64	64	}
65	65
66		# follow is test
67		do {
	66	# This is the actual tests
	67	{
68	68	my $unreliable = Moose::Meta::Class->create_anon_class(
69	69	superclasses => [],
70	70	roles => [qw/Restartable::ButUnreliable/],

74	74	'load_state' => sub { },
75	75	},
76	76	)->new_object();
77		ok $unreliable, 'Restartable::ButUnreliable based class';
78		can_ok $unreliable, qw/start stop/, '... can call start and stop';
79		};
	77	ok $unreliable, 'made anon class with Restartable::ButUnreliable role';
	78	can_ok $unreliable, qw/start stop/;
	79	}
80	80
81		do {
	81	{
82	82	my $cnt = 0;
83	83	my $broken = Moose::Meta::Class->create_anon_class(
84	84	superclasses => [],

89	89	'load_state' => sub { },
90	90	},
91	91	)->new_object();
92		ok $broken, 'Restartable::ButBroken based class';
	92	ok $broken, 'made anon class with Restartable::ButBroken role';
93	93	$broken->start();
94		is $cnt, 1, '... start is exploded';
	94	is $cnt, 1, '... start called explode';
95	95	$broken->stop();
96		is $cnt, 2, '... stop is also exploeded';
97		};
	96	is $cnt, 2, '... stop also called explode';
	97	}

+11

-1

t/020_attributes/016_attribute_traits_registered.t less more

2	2	use strict;
3	3	use warnings;
4	4
5		use Test::More tests => 16;
	5	use Test::More tests => 24;
6	6	use Test::Exception;
7	7	use Test::Moose;
8	8

87	87	does_ok($bar_attr, 'My::Attribute::Trait');
88	88	is($bar_attr->foo, "blah", "attr initialized");
89	89
	90	ok(!$bar_attr->meta->does_role('Aliased'), "does_role ignores aliases for sanity");
	91	ok($bar_attr->does('Aliased'), "attr->does uses aliases");
	92	ok(!$bar_attr->meta->does_role('Fictional'), "does_role returns false for nonexistent roles");
	93	ok(!$bar_attr->does('Fictional'), "attr->does returns false for nonexistent roles");
	94
90	95	my $quux = My::Derived::Class->new(bar => 1000);
91	96
92	97	is($quux->bar, 1000, '... got the right value for bar');

103	108
104	109	is($derived_bar_attr->the_other_attr, "oink", "attr initialized" );
105	110
	111	ok(!$derived_bar_attr->meta->does_role('Aliased'), "does_role ignores aliases for sanity");
	112	ok($derived_bar_attr->does('Aliased'), "attr->does uses aliases");
	113	ok(!$derived_bar_attr->meta->does_role('Fictional'), "does_role returns false for nonexistent roles");
	114	ok(!$derived_bar_attr->does('Fictional'), "attr->does returns false for nonexistent roles");
	115
106	116	can_ok($quux, 'additional_method');
107	117	is(eval { $quux->additional_method }, 42, '... got the right value for additional_method');
108	118

+7

-2

t/030_roles/002_role.t less more

2	2	use strict;
3	3	use warnings;
4	4
5		use Test::More tests => 35;
	5	use Test::More tests => 37;
6	6	use Test::Exception;
7	7
8	8	BEGIN {

44	44	::dies_ok { extends() } '... extends() is not supported';
45	45	::dies_ok { augment() } '... augment() is not supported';
46	46	::dies_ok { inner() } '... inner() is not supported';
	47
	48	no Moose::Role;
47	49	}
48	50
49	51	my $foo_role = FooRole->meta;

69	71	[ sort $foo_role->get_method_list() ],
70	72	[ 'boo', 'foo' ],
71	73	'... got the right method list');
72
	74
	75	ok(FooRole->can('foo'), "locally defined methods are still there");
	76	ok(!FooRole->can('has'), "sugar was unimported");
	77
73	78	# attributes ...
74	79
75	80	is_deeply(

+14

-2

t/030_roles/013_method_aliasing_in_composition.t less more

2	2	use strict;
3	3	use warnings;
4	4
5		use Test::More tests => 31;
	5	use Test::More tests => 36;
6	6	use Test::Exception;
7	7
8	8	BEGIN {

59	59	}
60	60
61	61	ok(My::OtherRole->meta->has_method($_), "we have a $_ method") for qw(foo baz role_bar);
62		ok(My::OtherRole->meta->requires_method('bar'), '... and the &bar method is required');
	62	ok(!My::OtherRole->meta->requires_method('bar'), '... and the &bar method is not required');
63	63	ok(!My::OtherRole->meta->requires_method('role_bar'), '... and the &role_bar method is not required');
	64
	65	{
	66	package My::AliasingRole;
	67	use Moose::Role;
	68
	69	::lives_ok {
	70	with 'My::Role' => { alias => { bar => 'role_bar' } };
	71	} '... this succeeds';
	72	}
	73
	74	ok(My::AliasingRole->meta->has_method($_), "we have a $_ method") for qw(foo baz role_bar);
	75	ok(My::AliasingRole->meta->requires_method('bar'), '... and the &bar method is required');
64	76
65	77	{
66	78	package Foo::Role;