our $VERSION = '0.02';
our $AUTHORITY = 'cpan:STEVAN';
-use base 'Class::MOP::Method';
+use base 'Class::MOP::Method';
# NOTE:
-# this ugly beast is the result of trying
+# this ugly beast is the result of trying
# to micro optimize this as much as possible
# while not completely loosing maintainability.
# At this point it's "fast enough", after all
my $modifier_table = shift;
my ($before, $after, $around) = (
$modifier_table->{before},
- $modifier_table->{after},
- $modifier_table->{around},
+ $modifier_table->{after},
+ $modifier_table->{around},
);
if (@$before && @$after) {
$modifier_table->{cache} = sub {
$_->(@_) for @{$before};
my @rval;
((defined wantarray) ?
- ((wantarray) ?
- (@rval = $around->{cache}->(@_))
- :
+ ((wantarray) ?
+ (@rval = $around->{cache}->(@_))
+ :
($rval[0] = $around->{cache}->(@_)))
:
$around->{cache}->(@_));
- $_->(@_) for @{$after};
+ $_->(@_) for @{$after};
return unless defined wantarray;
return wantarray ? @rval : $rval[0];
- }
+ }
}
elsif (@$before && !@$after) {
$modifier_table->{cache} = sub {
$_->(@_) for @{$before};
return $around->{cache}->(@_);
- }
+ }
}
elsif (@$after && !@$before) {
$modifier_table->{cache} = sub {
my @rval;
((defined wantarray) ?
- ((wantarray) ?
- (@rval = $around->{cache}->(@_))
- :
+ ((wantarray) ?
+ (@rval = $around->{cache}->(@_))
+ :
($rval[0] = $around->{cache}->(@_)))
:
$around->{cache}->(@_));
- $_->(@_) for @{$after};
+ $_->(@_) for @{$after};
return unless defined wantarray;
return wantarray ? @rval : $rval[0];
- }
+ }
}
else {
$modifier_table->{cache} = $around->{cache};
my $class = shift;
my $code = shift;
(blessed($code) && $code->isa('Class::MOP::Method'))
- || confess "Can only wrap blessed CODE";
- my $modifier_table = {
+ || confess "Can only wrap blessed CODE";
+ my $modifier_table = {
cache => undef,
orig => $code,
before => [],
- after => [],
+ after => [],
around => {
cache => $code->body,
- methods => [],
+ methods => [],
},
};
$_build_wrapped_method->($modifier_table);
- my $method = $class->SUPER::wrap(sub { $modifier_table->{cache}->(@_) });
+ my $method = $class->SUPER::wrap(sub { $modifier_table->{cache}->(@_) });
$method->{'%!modifier_table'} = $modifier_table;
- $method;
+ $method;
}
sub get_original_method {
- my $code = shift;
+ my $code = shift;
$code->{'%!modifier_table'}->{orig};
}
my $code = shift;
my $modifier = shift;
push @{$code->{'%!modifier_table'}->{after}} => $modifier;
- $_build_wrapped_method->($code->{'%!modifier_table'});
+ $_build_wrapped_method->($code->{'%!modifier_table'});
}
{
# NOTE:
- # this is another possible canidate for
+ # this is another possible candidate for
# optimization as well. There is an overhead
- # associated with the currying that, if
+ # associated with the currying that, if
# eliminated might make around modifiers
# more manageable.
my $compile_around_method = sub {{
sub add_around_modifier {
my $code = shift;
my $modifier = shift;
- unshift @{$code->{'%!modifier_table'}->{around}->{methods}} => $modifier;
+ unshift @{$code->{'%!modifier_table'}->{around}->{methods}} => $modifier;
$code->{'%!modifier_table'}->{around}->{cache} = $compile_around_method->(
@{$code->{'%!modifier_table'}->{around}->{methods}},
$code->{'%!modifier_table'}->{orig}->body
);
- $_build_wrapped_method->($code->{'%!modifier_table'});
- }
+ $_build_wrapped_method->($code->{'%!modifier_table'});
+ }
}
1;
=pod
-=head1 NAME
+=head1 NAME
Class::MOP::Method::Wrapped - Method Meta Object to handle before/around/after modifiers
L<http://www.iinteractive.com>
This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
+it under the same terms as Perl itself.
=cut