| Subject: | Performance improvement |
Hello,
Because method modifiers are really useful, I have written its XS
implementation in Data::Util, which is faster than the current
implementation (v0.75), especially in "before" and "after" modifiers.
Moreover, even if no C compiler is available, Data::Util works currectly
because it has also a Pure Perl impementation.
I have attached a patch using Data::Util, requiring v0.43. All
the tests in Class::MOP(v0.75) and Moose(v0.64) are passed successfully.
Regards.
--
Goro Fuji (gfx) GFUJI at CPAN.org
| Subject: | Wrapped.diff |
--- lib/Class/MOP/Method/Wrapped.pm.orig 2009-01-01 01:39:14.000000000 +0900
+++ lib/Class/MOP/Method/Wrapped.pm 2009-01-19 16:09:27.268457000 +0900
@@ -5,7 +5,7 @@
use warnings;
use Carp 'confess';
-use Scalar::Util 'blessed';
+use Data::Util;
our $VERSION = '0.75';
$VERSION = eval $VERSION;
@@ -13,148 +13,57 @@
use base 'Class::MOP::Method';
-# NOTE:
-# 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
-# you can't get something for nothing :)
-my $_build_wrapped_method = sub {
- my $modifier_table = shift;
- my ($before, $after, $around) = (
- $modifier_table->{before},
- $modifier_table->{after},
- $modifier_table->{around},
- );
- if (@$before && @$after) {
- $modifier_table->{cache} = sub {
- $_->(@_) for @{$before};
- my @rval;
- ((defined wantarray) ?
- ((wantarray) ?
- (@rval = $around->{cache}->(@_))
- :
- ($rval[0] = $around->{cache}->(@_)))
- :
- $around->{cache}->(@_));
- $_->(@_) 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}->(@_))
- :
- ($rval[0] = $around->{cache}->(@_)))
- :
- $around->{cache}->(@_));
- $_->(@_) for @{$after};
- return unless defined wantarray;
- return wantarray ? @rval : $rval[0];
- }
- }
- else {
- $modifier_table->{cache} = $around->{cache};
- }
-};
-
sub wrap {
my ( $class, $code, %params ) = @_;
- (blessed($code) && $code->isa('Class::MOP::Method'))
+ Data::Util::is_instance($code, 'Class::MOP::Method')
|| confess "Can only wrap blessed CODE";
- my $modifier_table = {
- cache => undef,
- orig => $code,
- before => [],
- after => [],
- around => {
- cache => $code->body,
- methods => [],
- },
- };
- $_build_wrapped_method->($modifier_table);
my $method = $class->SUPER::wrap(
- sub { $modifier_table->{cache}->(@_) },
- # get these from the original
- # unless explicitly overriden
+ Data::Util::modify_subroutine($code->body),
package_name => $params{package_name} || $code->package_name,
name => $params{name} || $code->name,
);
- $method->{'modifier_table'} = $modifier_table;
+ $method->{original} = $code;
$method;
}
sub get_original_method {
my $code = shift;
- $code->{'modifier_table'}->{orig};
+ $code->{original};
}
sub add_before_modifier {
my $code = shift;
my $modifier = shift;
- unshift @{$code->{'modifier_table'}->{before}} => $modifier;
- $_build_wrapped_method->($code->{'modifier_table'});
+ Data::Util::subroutine_modifier($code->body, before => $modifier);
}
sub before_modifiers {
my $code = shift;
- return @{$code->{'modifier_table'}->{before}};
+ Data::Util::subroutine_modifier($code->body, 'before');
}
sub add_after_modifier {
my $code = shift;
my $modifier = shift;
- push @{$code->{'modifier_table'}->{after}} => $modifier;
- $_build_wrapped_method->($code->{'modifier_table'});
+ Data::Util::subroutine_modifier($code->body, after => $modifier);
}
sub after_modifiers {
my $code = shift;
- return @{$code->{'modifier_table'}->{after}};
+ Data::Util::subroutine_modifier($code->body, 'after');
}
-{
- # NOTE:
- # this is another possible candidate for
- # optimization as well. There is an overhead
- # associated with the currying that, if
- # eliminated might make around modifiers
- # more manageable.
- my $compile_around_method = sub {{
- my $f1 = pop;
- return $f1 unless @_;
- my $f2 = pop;
- push @_, sub { $f2->( $f1, @_ ) };
- redo;
- }};
-
- sub add_around_modifier {
+sub add_around_modifier {
my $code = shift;
my $modifier = shift;
- 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'});
- }
+ Data::Util::subroutine_modifier($code->body, around => $modifier);
}
sub around_modifiers {
my $code = shift;
- return @{$code->{'modifier_table'}->{around}->{methods}};
+ Data::Util::subroutine_modifier($code->body, 'around');
}
1;