X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FMethod.pm;h=64fb24e663848be72424ad4af24643ee586e318e;hb=6038ad58fc973409650490c9dcc0c4302a084044;hp=ea580ab478c84f02f9480c3c223ed361c69ee929;hpb=c2310a31813d069ab9c12ff55de27817a3899b61;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm index ea580ab..64fb24e 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', 'reftype'; +use Scalar::Util 'weaken', 'reftype', 'blessed'; -our $VERSION = '0.89'; +our $VERSION = '1.04'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -28,8 +28,15 @@ sub wrap { my %params = @args; my $code = $params{body}; - (ref $code && 'CODE' eq reftype($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; } @@ -139,8 +151,9 @@ introspection interface. =item B<< Class::MOP::Method->wrap($code, %options) >> -This is the constructor. It accepts a subroutine reference and a hash -of options. +This is the constructor. It accepts a method body in the form of +either a code reference or a L instance, followed +by a hash of options. The options are: @@ -148,11 +161,13 @@ The options are: =item * name -The method name (without a package name). This is required. +The method name (without a package name). This is required if C<$code> +is a coderef. =item * package_name -The package name for the method. This is required. +The package name for the method. This is required if C<$code> is a +coderef. =item * associated_metaclass @@ -254,7 +269,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2009 by Infinity Interactive, Inc. +Copyright 2006-2010 by Infinity Interactive, Inc. L