X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FRole%2FApplication%2FToInstance.pm;h=2cb991fa763f4fb1aff05b0be35dcb8d73c40f3a;hb=0855da6beee716a87028f0531c220b1e4b21c943;hp=2b31d77dea72dfb59baf930c87c7476f2d9395ca;hpb=b7ef2be4b4b814c7ef52b96cc33e7fb4581428ba;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Role/Application/ToInstance.pm b/lib/Moose/Meta/Role/Application/ToInstance.pm index 2b31d77..2cb991f 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.95'; +our $VERSION = '1.21'; $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;