From: Dave Rolsky Date: Mon, 18 Jan 2010 04:18:15 +0000 (-0600) Subject: Squashed commit of the following: X-Git-Tag: 0.94~7 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=560c498d90d36bb5e56c077d496f395f817698b9;p=gitmo%2FMoose.git Squashed commit of the following: Improved support for anon roles by allowing meta role object wherever role name is allowed commit 8b20238f2e370635548437ff49835db07a6debfb Author: Dave Rolsky Date: Sun Jan 17 11:46:01 2010 -0600 Allow role meta objects to be supplied wherever we currently take a role name. --- diff --git a/Changes b/Changes index 34b5a34..c209b8d 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,23 @@ Also see Moose::Manual::Delta for more details of, and workarounds for, noteworthy changes. +next + +[ENHANCEMENTS] + +* Improved support for anonymous roles by changing various APIs to take + Moose::Meta::Role objects as well as role names. This included + + - Moose::Meta::Class->does_role + - Moose::Meta::Role->does_role + - Moose::Util::does_role + - Moose::Util::apply_all_roles + - Moose::Util::ensure_all_roles + - Moose::Util::search_class_by_role + + Requested by Shawn Moore. Addresses RT #51143 (and then some). (Dave Rolsky) + + 0.93_03 Tue, Jan 5, 2009 [BUG FIXES] diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 856538b..6a45f48 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -743,10 +743,11 @@ adds it to the class's list of role applications. This I actually apply any role to the class; it is only for tracking role applications. -=item B<< $metaclass->does_role($role_name) >> +=item B<< $metaclass->does_role($role) >> -This returns a boolean indicating whether or not the class does the -specified role. This tests both the class and its parents. +This returns a boolean indicating whether or not the class does the specified +role. The role provided can be either a role name or a L +object. This tests both the class and its parents. =item B<< $metaclass->excludes_role($role_name) >> diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm index 0139b98..1de3380 100644 --- a/lib/Moose/Meta/Role.pm +++ b/lib/Moose/Meta/Role.pm @@ -371,9 +371,10 @@ sub calculate_all_roles { } sub does_role { - my ($self, $role_name) = @_; - (defined $role_name) + my ($self, $role) = @_; + (defined $role) || Moose->throw_error("You must supply a role name to look for"); + my $role_name = blessed $role ? $role->name : $role; # if we are it,.. then return true return 1 if $role_name eq $self->name; # otherwise.. check our children @@ -427,8 +428,11 @@ sub combine { my (@roles, %role_params); while (@role_specs) { - my ($role_name, $params) = @{ splice @role_specs, 0, 1 }; - my $requested_role = Class::MOP::class_of($role_name); + my ($role, $params) = @{ splice @role_specs, 0, 1 }; + my $requested_role + = blessed $role + ? $role + : Class::MOP::class_of($role); my $actual_role = $requested_role->_role_for_combination($params); push @roles => $actual_role; @@ -702,7 +706,7 @@ This method creates a new role object with the provided name. =item B<< Moose::Meta::Role->combine( [ $role => { ... } ], [ $role ], ... ) >> This method accepts a list of array references. Each array reference -should contain a role name as its first element. The second element is +should contain a role name or L object as its first element. The second element is an optional hash reference. The hash reference can contain C<-excludes> and C<-alias> keys to control how methods are composed from the role. @@ -766,10 +770,10 @@ list may include duplicates. This returns a I list of all roles that this role does, and all the roles that its roles do. -=item B<< $metarole->does_role($role_name) >> +=item B<< $metarole->does_role($role) >> -Given a role I, returns true if this role does the given -role. +Given a role I or L object, returns true if this role +does the given role. =item B<< $metarole->add_role($role) >> diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm index 8c4ca50..4ba6456 100644 --- a/lib/Moose/Util.pm +++ b/lib/Moose/Util.pm @@ -51,12 +51,14 @@ sub does_role { } sub search_class_by_role { - my ($class_or_obj, $role_name) = @_; + my ($class_or_obj, $role) = @_; my $meta = find_meta($class_or_obj); return unless defined $meta; + my $role_name = blessed $role ? $role->name : $role; + foreach my $class ($meta->class_precedence_list) { my $_meta = find_meta($class); @@ -95,9 +97,17 @@ sub _apply_all_roles { my $roles = Data::OptList::mkopt( [@_] ); + my @role_metas; foreach my $role (@$roles) { - Class::MOP::load_class( $role->[0] ); - my $meta = Class::MOP::class_of( $role->[0] ); + my $meta; + + if ( blessed $role->[0] ) { + $meta = $role->[0]; + } + else { + Class::MOP::load_class( $role->[0] ); + $meta = Class::MOP::class_of( $role->[0] ); + } unless ($meta && $meta->isa('Moose::Meta::Role') ) { require Moose; @@ -105,23 +115,24 @@ sub _apply_all_roles { . $role->[0] . " is not a Moose role" ); } + + push @role_metas, [ $meta, $role->[1] ]; } if ( defined $role_filter ) { - @$roles = grep { local $_ = $_->[0]; $role_filter->() } @$roles; + @role_metas = grep { local $_ = $_->[0]; $role_filter->() } @role_metas; } - return unless @$roles; + return unless @role_metas; my $meta = ( blessed $applicant ? $applicant : find_meta($applicant) ); - if ( scalar @$roles == 1 ) { - my ( $role, $params ) = @{ $roles->[0] }; - my $role_meta = Class::MOP::class_of($role); - $role_meta->apply( $meta, ( defined $params ? %$params : () ) ); + if ( scalar @role_metas == 1 ) { + my ( $role, $params ) = @{ $role_metas[0] }; + $role->apply( $meta, ( defined $params ? %$params : () ) ); } else { - Moose::Meta::Role->combine( @$roles )->apply($meta); + Moose::Meta::Role->combine(@role_metas)->apply($meta); } } @@ -290,16 +301,19 @@ This method takes a class name or object and attempts to find a metaclass for the class, if one exists. It will B create one if it does not yet exist. -=item B +=item B -Returns true if C<$class_or_obj> does the given C<$role_name>. +Returns true if C<$class_or_obj> does the given C<$role_or_obj>. The role can +be provided as a name or a L object. -The class must already have a metaclass for this to work. +The class must already have a metaclass for this to work. If it doesn't, this +function simply returns false. -=item B +=item B Returns the first class in the class's precedence list that does -C<$role_name>, if any. +C<$role_or_obj>, if any. The role can be either a name or a +L object. The class must already have a metaclass for this to work. @@ -310,9 +324,9 @@ applicant can be a role name, class name, or object. The C<$applicant> must already have a metaclass object. -The list of C<@roles> should be a list of names, each of which can be -followed by an optional hash reference of options (C<-excludes> and -C<-alias>). +The list of C<@roles> should a list of names or L objects, +each of which can be followed by an optional hash reference of options +(C<-excludes> and C<-alias>). =item B diff --git a/t/400_moose_util/003_moose_util_search_class_by_role.t b/t/400_moose_util/003_moose_util_search_class_by_role.t index fa18dcf..b618498 100644 --- a/t/400_moose_util/003_moose_util_search_class_by_role.t +++ b/t/400_moose_util/003_moose_util_search_class_by_role.t @@ -17,6 +17,7 @@ BEGIN { use Moose; } is search_class_by_role('SCBR::A', 'SCBR::Role'), undef, '... not found role returns undef'; +is search_class_by_role('SCBR::A', SCBR::Role->meta), undef, '... not found role returns undef'; { package SCBR::B; use Moose; @@ -24,12 +25,14 @@ is search_class_by_role('SCBR::A', 'SCBR::Role'), undef, '... not found role ret with 'SCBR::Role'; } is search_class_by_role('SCBR::B', 'SCBR::Role'), 'SCBR::B', '... class itself returned if it does role'; +is search_class_by_role('SCBR::B', SCBR::Role->meta), 'SCBR::B', '... class itself returned if it does role'; { package SCBR::C; use Moose; extends 'SCBR::B'; } is search_class_by_role('SCBR::C', 'SCBR::Role'), 'SCBR::B', '... nearest class doing role returned'; +is search_class_by_role('SCBR::C', SCBR::Role->meta), 'SCBR::B', '... nearest class doing role returned'; { package SCBR::D; use Moose; @@ -37,5 +40,6 @@ is search_class_by_role('SCBR::C', 'SCBR::Role'), 'SCBR::B', '... nearest class with 'SCBR::Role'; } is search_class_by_role('SCBR::D', 'SCBR::Role'), 'SCBR::D', '... nearest class being direct class returned'; +is search_class_by_role('SCBR::D', SCBR::Role->meta), 'SCBR::D', '... nearest class being direct class returned'; done_testing; diff --git a/t/400_moose_util/007_apply_roles.t b/t/400_moose_util/007_apply_roles.t new file mode 100644 index 0000000..48edea7 --- /dev/null +++ b/t/400_moose_util/007_apply_roles.t @@ -0,0 +1,71 @@ +use strict; +use warnings; + +use Test::More; +use Moose::Util qw( apply_all_roles ); + +{ + package Role::Foo; + use Moose::Role; +} + +{ + package Role::Bar; + use Moose::Role; +} + +{ + package Role::Baz; + use Moose::Role; +} + +{ + package Class::A; + use Moose; +} + +{ + package Class::B; + use Moose; +} + +{ + package Class::C; + use Moose; +} + +{ + package Class::D; + use Moose; +} + +{ + package Class::E; + use Moose; +} + +my @roles = qw( Role::Foo Role::Bar Role::Baz ); +apply_all_roles( 'Class::A', @roles ); +ok( Class::A->meta->does_role($_), "Class::A does $_" ) for @roles; + +apply_all_roles( 'Class::B', map { $_->meta } @roles ); +ok( Class::A->meta->does_role($_), + "Class::B does $_ (applied with meta role object)" ) + for @roles; + +@roles = qw( Role::Foo ); +apply_all_roles( 'Class::C', @roles ); +ok( Class::A->meta->does_role($_), "Class::C does $_" ) for @roles; + +apply_all_roles( 'Class::D', map { $_->meta } @roles ); +ok( Class::A->meta->does_role($_), + "Class::D does $_ (applied with meta role object)" ) + for @roles; + +@roles = qw( Role::Foo Role::Bar ), Role::Baz->meta; +apply_all_roles( 'Class::E', @roles ); +ok( Class::A->meta->does_role($_), + "Class::E does $_ (mix of names and meta role object)" ) + for @roles; + +done_testing;