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=81c5099fd7f83e4d6b503d60a776cb23c6b5f006;hpb=c808e3d5c3b5fa953d6b9a3ee7ce4cd2b7925f6c;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Method/Wrapped.pm b/lib/Class/MOP/Method/Wrapped.pm index 81c5099..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.67'; +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 { @@ -108,6 +128,11 @@ sub add_before_modifier { $_build_wrapped_method->($code->{'modifier_table'}); } +sub before_modifiers { + my $code = shift; + return @{$code->{'modifier_table'}->{before}}; +} + sub add_after_modifier { my $code = shift; my $modifier = shift; @@ -115,6 +140,11 @@ sub add_after_modifier { $_build_wrapped_method->($code->{'modifier_table'}); } +sub after_modifiers { + my $code = shift; + return @{$code->{'modifier_table'}->{after}}; +} + { # NOTE: # this is another possible candidate for @@ -142,6 +172,11 @@ sub add_after_modifier { } } +sub around_modifiers { + my $code = shift; + return @{$code->{'modifier_table'}->{around}->{methods}}; +} + 1; __END__ @@ -150,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 @@ -163,31 +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 + +=item * name + +The method name (without a package name). This will be taken from the +provided L object if it is not provided. + +=item * package_name + +The package name for the method. This will be taken from the provided +L object if it is not provided. + +=item * associated_metaclass + +An optional L object. This is the metaclass for the +method's class. =back -=head2 Modifiers +=item B<< $metamethod->get_original_method >> + +This returns the L object that was passed to the +constructor. -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 B<< $metamethod->add_before_modifier($code) >> -=over 4 +=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 @@ -197,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