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]
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<Moose::Meta::Role>
+object. This tests both the class and its parents.
=item B<< $metaclass->excludes_role($role_name) >>
}
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
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;
=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<Moose::Meta::Role> 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.
This returns a I<unique> 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<name>, returns true if this role does the given
-role.
+Given a role I<name> or L<Moose::Meta::Role> object, returns true if this role
+does the given role.
=item B<< $metarole->add_role($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);
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;
. $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);
}
}
metaclass for the class, if one exists. It will B<not> create one if it
does not yet exist.
-=item B<does_role($class_or_obj, $role_name)>
+=item B<does_role($class_or_obj, $role_or_obj)>
-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<Moose::Meta::Role> 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<search_class_by_role($class_or_obj, $role_name)>
+=item B<search_class_by_role($class_or_obj, $role_or_obj)>
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<Moose::Meta::Role> object.
The class must already have a metaclass for this to work.
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<Moose::Meta::Role> objects,
+each of which can be followed by an optional hash reference of options
+(C<-excludes> and C<-alias>).
=item B<ensure_all_roles($applicant, @roles)>
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;
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;
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;
--- /dev/null
+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;
projects / gitmo/Moose.git / commitdiff