X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FMethod%2FWrapped.pm;h=ba5eb5f36db6b9a922286006179781337e6a61d1;hb=1af3d9e7321d3d561b1c6da5c943af9a64032cee;hp=04bb7603c9bb6a9ef05896fae69306d478b552ab;hpb=7391b97976a69ee8ca74f0e0bee7f48df4cf4806;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Method/Wrapped.pm b/lib/Class/MOP/Method/Wrapped.pm index 04bb760..ba5eb5f 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.78'; +our $VERSION = '1.00'; $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 { @@ -235,7 +255,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