Fast Method Modifiers

Data::Util 0.29_01にcurry()とwrap_subroutine()*1，subroutine_modifier()*2を追加して，そのデモとしてData::Util::MethodModifiersを実装したよ！

#!perl -w
use strict;
{
  package Foo;
  use Data::Util::MethodModifiers;
  before foo => sub{ print "before!\n" };
  after  foo => sub{ print "after!\n" };
  sub foo => sub{ print "foo!\n" }
}
Foo->foo();
# =>
# before!
# foo!
# after!

いつものように呼び出し速度のベンチマークをとってみた。
mooseがMoose，cmmがClass::Method::Modifiers，wrapがData::Util::MethodModifiersで，いずれも定義コードは同じ。

Perl 5.8.9 on i686-linux
Data::Util(XS)/0.29_01
Class::Method::Modifiers(PurePerl)/1.01
Moose(PurePerl)/0.6

Calling subroutine with before modifiers:
          Rate moose   cmm  wrap
moose 200386/s    --  -31%  -61%
cmm   290444/s   45%    --  -43%
wrap  508970/s  154%   75%    --

Calling subroutine with around modifiers:
          Rate moose   cmm  wrap
moose 286719/s    --   -7%  -21%
cmm   306652/s    7%    --  -15%
wrap  362464/s   26%   18%    --

Calling subroutine with after modifiers:
          Rate moose   cmm  wrap
moose 182044/s    --  -14%  -64%
cmm   210823/s   16%    --  -58%
wrap  499367/s  174%  137%    --

CMMはドキュメントで「Mooseより速い」とうたっているだけあって確かにMooseより速いみたいだけど，それでもXSには適わないね。というかaroundは若干速いだけだけど，beforeとafterのData::Util版は速すぎるぞ。なんでこんなに速いんだろ。まあいいけど。
ベンチマークスクリプト(Data-Util/benchmark/modifier_bench.pl)：

#!perl -w
use strict;
use Benchmark qw(:all);

{
	package Base;
	sub f{ 42 }
	sub g{ 42 }
	sub h{ 42 }
}


my $i = 0;
sub around{
	my $next = shift;
	$i++;
	$next->(@_);
}
{
	package DUMM;
	use parent -norequire => qw(Base);
	use Data::Util::MethodModifiers;

	before f => sub{ $i++ };
	around g => \&main::around;
	after  h => sub{ $i++ };
}
{
	package CMM;
	use parent -norequire => qw(Base);
	use Class::Method::Modifiers;

	before f => sub{ $i++ };
	around g => \&main::around;
	after  h => sub{ $i++ };
}
{
	package MOP;
	use parent -norequire => qw(Base);
	use Moose;

	before f => sub{ $i++ };
	around g => \&main::around;
	after  h => sub{ $i++ };
}

signeture
	'Data::Util' => \&Data::Util::wrap_subroutine,
	'Moose' => \&Moose::around,
	'Class::Method::Modifiers' => \&Class::Method::Modifiers::around,
;

print "Calling subroutine with before modifiers:\n";
cmpthese -1 => {
	wrap => sub{
		my $old = $i;
		DUMM->f();
		$i == ($old+1) or die $i;
	},
	cmm => sub{
		my $old = $i;
		CMM->f();
		$i == ($old+1) or die $i;
	},
	moose => sub{
		my $old = $i;
		MOP->f();
		$i == ($old+1) or die $i;
	}
};

print "\n", "Calling subroutine with around modifiers:\n";
cmpthese -1 => {
	wrap => sub{
		my $old = $i;
		DUMM->g();
		$i == ($old+1) or die $i;
	},
	cmm => sub{
		my $old = $i;
		CMM->g();
		$i == ($old+1) or die $i;
	},
	moose => sub{
		my $old = $i;
		MOP->g();
		$i == ($old+1) or die $i;
	}
};
print "\n", "Calling subroutine with after modifiers:\n";
cmpthese -1 => {
	wrap => sub{
		my $old = $i;
		DUMM->h();
		$i == ($old+1) or die $i;
	},
	cmm => sub{
		my $old = $i;
		CMM->h();
		$i == ($old+1) or die $i;
	},
	moose => sub{
		my $old = $i;
		MOP->h();
		$i == ($old+1) or die $i;
	}
};
__END__

*1:Modifiers付きサブルーチンのコンストラクタ。ただしブレスはしないのでいわゆるオブジェクトではない。

*2:Modifiers付きサブルーチンのアクセサ。Modifiers付きサブルーチンはいわゆるオブジェクトではないので，あくまでもサブルーチンとして呼び出す。