X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FRole%2FApplication%2FToClass.pm;h=843b97a0d7c59e0afcb1516803af2b155d4156c2;hb=4bf82ce13be926eca01d6b8f07b46625a98a56fa;hp=be5f9e013245a3c996029531890df1faf6dcc63a;hpb=92d8204181e20d7b6a0144fca0a99095a7788ff4;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Role/Application/ToClass.pm b/lib/Moose/Meta/Role/Application/ToClass.pm index be5f9e0..843b97a 100644 --- a/lib/Moose/Meta/Role/Application/ToClass.pm +++ b/lib/Moose/Meta/Role/Application/ToClass.pm @@ -7,7 +7,7 @@ use metaclass; use Moose::Util 'english_list'; use Scalar::Util 'weaken', 'blessed'; -our $VERSION = '0.87'; +our $VERSION = '0.98'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -73,20 +73,38 @@ sub check_required_methods { my $error = ''; + @missing = sort { $a->name cmp $b->name } @missing; my @conflicts = grep { $_->isa('Moose::Meta::Role::Method::Conflicting') } @missing; if (@conflicts) { my $conflict = $conflicts[0]; - my $roles = Moose::Util::english_list( map { q{'} . $_ . q{'} } @{ $conflict->roles } ); - - $error - .= "Due to a method name conflict in roles " - . $roles - . ", the method '" - . $conflict->name - . "' must be implemented or excluded by '" - . $class->name - . q{'}; + my $roles = $conflict->roles_as_english_list; + + my @same_role_conflicts = grep { $_->roles_as_english_list eq $roles } @conflicts; + + if (@same_role_conflicts == 1) { + $error + .= "Due to a method name conflict in roles " + . $roles + . ", the method '" + . $conflict->name + . "' must be implemented or excluded by '" + . $class->name + . q{'}; + } + else { + my $methods + = Moose::Util::english_list( map { q{'} . $_->name . q{'} } @same_role_conflicts ); + + $error + .= "Due to method name conflicts in roles " + . $roles + . ", the methods " + . $methods + . " must be implemented or excluded by '" + . $class->name + . q{'}; + } } elsif (@missing) { my $noun = @missing == 1 ? 'method' : 'methods'; @@ -111,6 +129,8 @@ sub check_required_attributes { sub apply_attributes { my ($self, $role, $class) = @_; + my $attr_metaclass = $class->attribute_metaclass; + foreach my $attribute_name ($role->get_attribute_list) { # it if it has one already if ($class->has_attribute($attribute_name) && @@ -120,8 +140,7 @@ sub apply_attributes { } else { $class->add_attribute( - $attribute_name, - $role->get_attribute($attribute_name) + $role->get_attribute($attribute_name)->attribute_for_class($attr_metaclass) ); } } @@ -130,6 +149,7 @@ sub apply_attributes { sub apply_methods { my ($self, $role, $class) = @_; foreach my $method_name ($role->get_method_list) { + next if $method_name eq 'meta'; unless ($self->is_method_excluded($method_name)) { # it if it has one already @@ -239,9 +259,7 @@ Moose::Meta::Role::Application::ToClass - Compose a role into a class =head1 BUGS -All complex software has bugs lurking in it, and this module is no -exception. If you find a bug please either email me, or add the bug -to cpan-RT. +See L for details on reporting bugs. =head1 AUTHOR @@ -249,7 +267,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2009 by Infinity Interactive, Inc. +Copyright 2006-2010 by Infinity Interactive, Inc. L