X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FRole%2FApplication%2FToInstance.pm;h=42b3d61b4e2c3ec839915982ee01181fb8fc3013;hb=870d0f1a40aafaeab1155cae153ac60c47cd12ec;hp=abf16a7c6b94e492d0fa6033309760080d7ca89e;hpb=9b28d20beb0387349f6a7d6906c30404231cd463;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Role/Application/ToInstance.pm b/lib/Moose/Meta/Role/Application/ToInstance.pm index abf16a7..42b3d61 100644 --- a/lib/Moose/Meta/Role/Application/ToInstance.pm +++ b/lib/Moose/Meta/Role/Application/ToInstance.pm @@ -4,14 +4,19 @@ use strict; use warnings; use metaclass; -use Carp 'confess'; use Scalar::Util 'blessed'; -our $VERSION = '0.01'; +our $VERSION = '0.94'; +$VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; use base 'Moose::Meta::Role::Application::ToClass'; +__PACKAGE__->meta->add_attribute('rebless_params' => ( + reader => 'rebless_params', + default => sub { {} } +)); + my %ANON_CLASSES; sub apply { @@ -24,14 +29,23 @@ sub apply { $class = $ANON_CLASSES{$anon_role_key}; } else { - $class = Moose::Meta::Class->create_anon_class( + 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); + $class->rebless_instance($object, %{$self->rebless_params}); } 1; @@ -42,7 +56,7 @@ __END__ =head1 NAME -Moose::Meta::Role::Application::ToInstance +Moose::Meta::Role::Application::ToInstance - Compose a role into an instance =head1 DESCRIPTION @@ -56,13 +70,13 @@ Moose::Meta::Role::Application::ToInstance =item B +=item B + =back =head1 BUGS -All complex software has bugs lurking in it, and this module is no -exception. If you find a bug please either email me, or add the bug -to cpan-RT. +See L for details on reporting bugs. =head1 AUTHOR @@ -70,7 +84,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2008 by Infinity Interactive, Inc. +Copyright 2006-2010 by Infinity Interactive, Inc. L