X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FRole%2FApplication%2FToInstance.pm;h=e9c15d1753fb0795426a5b0de162320c477e1673;hb=a1224bfcd884034efdee87d80f8779b62f6b2f9b;hp=9834c9e11a6054fde3115c42d8de24ad756c25e8;hpb=a6f9a6cd26513ba2457f5b54bab12bee84bca5a1;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Role/Application/ToInstance.pm b/lib/Moose/Meta/Role/Application/ToInstance.pm index 9834c9e..e9c15d1 100644 --- a/lib/Moose/Meta/Role/Application/ToInstance.pm +++ b/lib/Moose/Meta/Role/Application/ToInstance.pm @@ -6,46 +6,35 @@ use metaclass; use Scalar::Util 'blessed'; -our $VERSION = '0.93_02'; +our $VERSION = '1.11'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; -use base 'Moose::Meta::Role::Application::ToClass'; +use base 'Moose::Meta::Role::Application'; __PACKAGE__->meta->add_attribute('rebless_params' => ( reader => 'rebless_params', default => sub { {} } )); -my %ANON_CLASSES; - sub apply { - my ($self, $role, $object) = @_; - - my $anon_role_key = (blessed($object) . $role->name); - - my $class; - if (exists $ANON_CLASSES{$anon_role_key} && defined $ANON_CLASSES{$anon_role_key}) { - $class = $ANON_CLASSES{$anon_role_key}; - } - else { - my $obj_meta = Class::MOP::class_of($object) || 'Moose::Meta::Class'; - - # This is a special case to handle the case where the object's - # metaclass is a Class::MOP::Class, but _not_ a Moose::Meta::Class - # (for example, when applying a role to a Moose::Meta::Attribute - # object). - $obj_meta = 'Moose::Meta::Class' - unless $obj_meta->isa('Moose::Meta::Class'); - - $class = $obj_meta->create_anon_class( - superclasses => [ blessed($object) ] - ); - $ANON_CLASSES{$anon_role_key} = $class; - $self->SUPER::apply($role, $class); - } - - $class->rebless_instance($object, %{$self->rebless_params}); + my ( $self, $role, $object, $args ) = @_; + + my $obj_meta = Class::MOP::class_of($object) || 'Moose::Meta::Class'; + + # This is a special case to handle the case where the object's metaclass + # is a Class::MOP::Class, but _not_ a Moose::Meta::Class (for example, + # when applying a role to a Moose::Meta::Attribute object). + $obj_meta = 'Moose::Meta::Class' + unless $obj_meta->isa('Moose::Meta::Class'); + + my $class = $obj_meta->create_anon_class( + superclasses => [ blessed($object) ], + roles => [ $role, keys(%$args) ? ($args) : () ], + cache => 1, + ); + + $class->rebless_instance( $object, %{ $self->rebless_params } ); } 1;