X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FMethod%2FWrapped.pm;h=e57615987bc83b5d4256e8cc0196a510fac838e8;hb=53edec17bae8aa34a398b0bd50dcd7e78e03b733;hp=9169fdbd7639ebd45ea7a5ad984d631aa17eab4a;hpb=c6e75cb33bd9fd33d777325cdc3de6d5de614263;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Method/Wrapped.pm b/lib/Class/MOP/Method/Wrapped.pm index 9169fdb..e576159 100644 --- a/lib/Class/MOP/Method/Wrapped.pm +++ b/lib/Class/MOP/Method/Wrapped.pm @@ -7,7 +7,7 @@ use warnings; use Carp 'confess'; use Scalar::Util 'blessed'; -our $VERSION = '0.81'; +our $VERSION = '0.95'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -28,7 +28,7 @@ my $_build_wrapped_method = sub { ); if (@$before && @$after) { $modifier_table->{cache} = sub { - $_->(@_) for @{$before}; + for my $c (@$before) { $c->(@_) }; my @rval; ((defined wantarray) ? ((wantarray) ? @@ -37,14 +37,14 @@ my $_build_wrapped_method = sub { ($rval[0] = $around->{cache}->(@_))) : $around->{cache}->(@_)); - $_->(@_) for @{$after}; + for my $c (@$after) { $c->(@_) }; return unless defined wantarray; return wantarray ? @rval : $rval[0]; } } elsif (@$before && !@$after) { $modifier_table->{cache} = sub { - $_->(@_) for @{$before}; + for my $c (@$before) { $c->(@_) }; return $around->{cache}->(@_); } } @@ -58,7 +58,7 @@ my $_build_wrapped_method = sub { ($rval[0] = $around->{cache}->(@_))) : $around->{cache}->(@_)); - $_->(@_) for @{$after}; + for my $c (@$after) { $c->(@_) }; return unless defined wantarray; return wantarray ? @rval : $rval[0]; } @@ -70,10 +70,10 @@ my $_build_wrapped_method = sub { sub wrap { my ( $class, $code, %params ) = @_; - + (blessed($code) && $code->isa('Class::MOP::Method')) || confess "Can only wrap blessed CODE"; - + my $modifier_table = { cache => undef, orig => $code, @@ -85,15 +85,35 @@ sub wrap { }, }; $_build_wrapped_method->($modifier_table); - my $method = $class->SUPER::wrap( + return $class->SUPER::wrap( sub { $modifier_table->{cache}->(@_) }, - # get these from the original + # get these from the original # unless explicitly overriden - package_name => $params{package_name} || $code->package_name, - name => $params{name} || $code->name, + package_name => $params{package_name} || $code->package_name, + name => $params{name} || $code->name, + + modifier_table => $modifier_table, ); - $method->{'modifier_table'} = $modifier_table; - $method; +} + +sub _new { + my $class = shift; + return Class::MOP::Class->initialize($class)->new_object(@_) + if $class ne __PACKAGE__; + + my $params = @_ == 1 ? $_[0] : {@_}; + + return bless { + # inherited from Class::MOP::Method + 'body' => $params->{body}, + 'associated_metaclass' => $params->{associated_metaclass}, + 'package_name' => $params->{package_name}, + 'name' => $params->{name}, + 'original_method' => $params->{original_method}, + + # defined in this class + 'modifier_table' => $params->{modifier_table} + } => $class; } sub get_original_method {