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=07a2ee5166383fd7de4342e6af0e3a8b4957027b;hpb=92e250b0af746085306392cd25e053f3000ca3d3;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Method/Wrapped.pm b/lib/Class/MOP/Method/Wrapped.pm index 07a2ee5..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.69_01'; +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 { @@ -165,12 +185,12 @@ __END__ =head1 NAME -Class::MOP::Method::Wrapped - Method Meta Object to handle before/around/after modifiers +Class::MOP::Method::Wrapped - Method Meta Object for methods with before/after/around modifiers =head1 DESCRIPTION -This is a L subclass which provides the funtionality -to wrap a given CODE reference with before, after and around method modifiers. +This is a L subclass which implements before, +after, and around method modifiers. =head1 METHODS @@ -178,44 +198,54 @@ to wrap a given CODE reference with before, after and around method modifiers. =over 4 -=item B +=item B<< Class::MOP::Method::Wrapped->wrap($metamethod, %options) >> -This is the constructor, it will return a B -instance that can be used to add before, after and around modifiers to. +This is the constructor. It accepts a L object and +a hash of options. -=item B +The options are: -This returns the original CODE reference that was provided to the -constructor. +=over 8 -=back +=item * name -=head2 Modifiers +The method name (without a package name). This will be taken from the +provided L object if it is not provided. -These three methods will add the method modifiers to the wrapped -CODE reference. For more information on how method modifiers work, -see the section in L. +=item * package_name -=over 4 - -=item B +The package name for the method. This will be taken from the provided +L object if it is not provided. -=item B +=item * associated_metaclass -=item B +An optional L object. This is the metaclass for the +method's class. =back -These three methods each returna list of method modifiers I. +=item B<< $metamethod->get_original_method >> -=over 4 +This returns the L object that was passed to the +constructor. + +=item B<< $metamethod->add_before_modifier($code) >> + +=item B<< $metamethod->add_after_modifier($code) >> + +=item B<< $metamethod->add_around_modifier($code) >> + +These methods all take a subroutine reference and apply it as a +modifier to the original method. + +=item B<< $metamethod->before_modifiers >> -=item B +=item B<< $metamethod->after_modifiers >> -=item B +=item B<< $metamethod->around_modifiers >> -=item B +These methods all return a list of subroutine references which are +acting as the specified type of modifier. =back @@ -225,7 +255,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