X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FMethod.pm;h=8041994d497bce4eece878a44f9f9c8f4140e2b0;hb=6db5c459d895adc8cea8f285f26aca1ea3c3cd14;hp=aa8c8637517e5336a477643b39c4359a3d8ed289;hpb=ea23e618007d485838d922d35c709936e09e9a35;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm index aa8c863..8041994 100644 --- a/lib/Class/MOP/Method.pm +++ b/lib/Class/MOP/Method.pm @@ -5,9 +5,9 @@ use strict; use warnings; use Carp 'confess'; -use Scalar::Util 'weaken'; +use Scalar::Util 'weaken', 'reftype', 'blessed'; -our $VERSION = '0.87'; +our $VERSION = '0.90'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -28,8 +28,15 @@ sub wrap { my %params = @args; my $code = $params{body}; - ('CODE' eq ref($code)) - || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")"; + if (blessed($code) && $code->isa(__PACKAGE__)) { + my $method = $code->clone; + delete $params{body}; + Class::MOP::class_of($class)->rebless_instance($method, %params); + return $method; + } + elsif (!ref $code || 'CODE' ne reftype($code)) { + confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")"; + } ($params{package_name} && $params{name}) || confess "You must supply the package_name and name parameters"; @@ -43,13 +50,18 @@ sub wrap { sub _new { my $class = shift; + + return Class::MOP::Class->initialize($class)->new_object(@_) + if $class ne __PACKAGE__; + my $params = @_ == 1 ? $_[0] : {@_}; - my $self = bless { + return bless { 'body' => $params->{body}, 'associated_metaclass' => $params->{associated_metaclass}, 'package_name' => $params->{package_name}, 'name' => $params->{name}, + 'original_method' => $params->{original_method}, } => $class; }