| Subject: | [PATCH] Use Class::XSAccessor for simple accessors |
Hi guys,
get/set_simple are the most-used methods in DBIC and always show up at
the top of my profiles. This little patch uses Class::XSAccessor for
them if available, which is quite a bit faster:
Rate cag_get cag_set xs_set xs_get
cag_get 602746/s -- -1% -57% -71%
cag_set 607293/s 1% -- -56% -71%
xs_set 1385965/s 130% 128% -- -34%
xs_get 2095760/s 248% 245% 51% --
Note I had to use a non-public method, since the only public way to
create accessors with XSAccessor appears to be via import().
| Subject: | accbench.pl |
#!/usr/local/bin/perl
package PP;
use base 'Class::Accessor::Grouped';
PP->mk_group_accessors( simple => 'foo' );
sub new {
bless {}, shift;
}
package XS;
use Class::XSAccessor;
Class::XSAccessor::newxs_accessor( 'XS::foo', 'foo', 0 );
sub new {
bless {}, shift;
}
package main;
use strict;
use Benchmark qw(cmpthese);
my $pp = PP->new;
my $xs = XS->new;
cmpthese( -5, {
cag_set => sub {
$pp->foo('set');
},
cag_get => sub {
my $x = $pp->foo();
},
xs_set => sub {
$xs->foo('set');
},
xs_get => sub {
my $x = $xs->foo();
},
} );
| Subject: | cag-xs-accessor.patch |
=== CPAN/Class/Accessor/Grouped.pm
==================================================================
--- CPAN/Class/Accessor/Grouped.pm (revision 54335)
+++ CPAN/Class/Accessor/Grouped.pm (local)
@@ -8,6 +8,22 @@
our $VERSION = '0.08003';
+BEGIN {
+ my $hasXS;
+
+ sub hasXS {
+ return $hasXS if defined $hasXS;
+
+ $hasXS = 0;
+ eval {
+ require Class::XSAccessor;
+ $hasXS = 1;
+ };
+
+ return $hasXS;
+ }
+}
+
=head1 NAME
Class::Accessor::Grouped - Lets you build groups of accessors
@@ -64,6 +80,8 @@
# So we don't have to do lots of lookups inside the loop.
$maker = $self->can($maker) unless ref $maker;
+
+ my $hasXS = hasXS();
foreach my $field (@fields) {
if( $field eq 'DESTROY' ) {
@@ -74,15 +92,20 @@
my $name = $field;
($name, $field) = @$field if ref $field;
+
+ if ( $hasXS && $group eq 'simple' ) {
+ Class::XSAccessor::newxs_accessor("${class}::${name}", $field, 0);
+ }
+ else {
+ my $accessor = $self->$maker($group, $field);
+ my $alias = "_${name}_accessor";
- my $accessor = $self->$maker($group, $field);
- my $alias = "_${name}_accessor";
+ *{$class."\:\:$name"} = $accessor;
+ #unless defined &{$class."\:\:$field"}
- *{$class."\:\:$name"} = $accessor;
- #unless defined &{$class."\:\:$field"}
-
- *{$class."\:\:$alias"} = $accessor;
- #unless defined &{$class."\:\:$alias"}
+ *{$class."\:\:$alias"} = $accessor;
+ #unless defined &{$class."\:\:$alias"}
+ }
}
}
}