X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil%2FMetaRole.pm;h=4b5934e069ee83f07654805bdd2245d7102d74f9;hb=8de5717850eb1f406e5f71d2ccfac33c72cc490b;hp=9d37761d65f6bceae8644ef209ce0090350355aa;hpb=5ef36adde3d619733607b9f5f1136524a00848df;p=gitmo%2FMoose.git diff --git a/lib/Moose/Util/MetaRole.pm b/lib/Moose/Util/MetaRole.pm index 9d37761..4b5934e 100644 --- a/lib/Moose/Util/MetaRole.pm +++ b/lib/Moose/Util/MetaRole.pm @@ -2,8 +2,9 @@ package Moose::Util::MetaRole; use strict; use warnings; +use Scalar::Util 'blessed'; -our $VERSION = '0.85'; +our $VERSION = '0.92'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -14,10 +15,12 @@ my @Classes = qw( constructor_class destructor_class error_class ); sub apply_metaclass_roles { my %options = @_; - my $for = $options{for_class}; + my $for = blessed $options{for_class} + ? $options{for_class} + : Class::MOP::class_of($options{for_class}); - my %old_classes = map { $_ => Class::MOP::class_of($for)->$_ } - grep { Class::MOP::class_of($for)->can($_) } + my %old_classes = map { $_ => $for->$_ } + grep { $for->can($_) } @Classes; my $meta = _make_new_metaclass( $for, \%options ); @@ -43,7 +46,7 @@ sub _make_new_metaclass { my $for = shift; my $options = shift; - return Class::MOP::class_of($for) + return $for unless grep { exists $options->{ $_ . '_roles' } } qw( metaclass @@ -51,22 +54,29 @@ sub _make_new_metaclass { method_metaclass wrapped_method_metaclass instance_metaclass + application_to_class_class + application_to_role_class + application_to_instance_class + application_role_summation_class ); - my $old_meta = Class::MOP::class_of($for); my $new_metaclass - = _make_new_class( ref $old_meta, $options->{metaclass_roles} ); + = _make_new_class( ref $for, $options->{metaclass_roles} ); # This could get called for a Moose::Meta::Role as well as a Moose::Meta::Class my %classes = map { - $_ => _make_new_class( $old_meta->$_(), $options->{ $_ . '_roles' } ) + $_ => _make_new_class( $for->$_(), $options->{ $_ . '_roles' } ) } - grep { $old_meta->can($_) } + grep { $for->can($_) } qw( attribute_metaclass method_metaclass wrapped_method_metaclass instance_metaclass + application_to_class_class + application_to_role_class + application_to_instance_class + application_role_summation_class ); return $new_metaclass->reinitialize( $for, %classes ); @@ -99,7 +109,8 @@ sub _make_new_class { my $meta = Class::MOP::Class->initialize($existing_class); return $existing_class - if $meta->can('does_role') && all { $meta->does_role($_) } @{$roles}; + if $meta->can('does_role') && all { $meta->does_role($_) } + grep { !ref $_ } @{$roles}; return Moose::Meta::Class->create_anon_class( superclasses => $superclasses, @@ -171,8 +182,8 @@ this when your module is imported, the caller should not have any attributes defined yet. The easiest way to ensure that this happens is to use -L and provide an C method that will be -called when imported. +L, which can generate the appropriate C +method for you, and make sure it is called when imported. =head1 FUNCTIONS @@ -203,6 +214,12 @@ This specifies the class for which to alter the meta classes. =item * destructor_class_roles => \@roles +=item * application_to_class_class_roles => \@roles + +=item * application_to_role_class_roles => \@roles + +=item * application_to_instance_class_roles => \@roles + These parameter all specify one or more roles to be applied to the specified metaclass. You can pass any or all of these parameters at once.