#!perl -w use strict; use Data::Util qw(:all); use Benchmark qw(:all); use FindBin qw($Bin); use lib $Bin; use Common; signeture 'Data::Util' => \&modify_subroutine; sub f { 42 } sub before { 1 } sub around { my $f = shift; $f->(@_) + 1; } sub after { 1 } my @before = (\&before, \&before); my @around = (\&around); my @after = (\&after, \&after); my $modified = modify_subroutine(\&f, before => \@before, around => \@around, after => \@after); sub modify{ my $subr = shift; my @before = @{(shift)}; my @around = @{(shift)}; my @after = @{(shift)}; $subr = curry($_, (my $tmp = $subr), *_) for @around; return sub{ $_->(@_) for @before; my @ret = wantarray ? $subr->(@_) : scalar $subr->(@_); $_->(@_) for @after; return wantarray ? @ret : $ret[0]; }; } my $closure = modify(\&f, \@before, \@around, \@after); $modified->(-1) == 43 or die $modified->(-10); $closure->(-2) == 43 or die $closure->(-20); print "Creation of modified subs:\n"; cmpthese timethese -1 => { modify => sub{ my $w = modify_subroutine(\&f, before => \@before, around => \@around, after => \@after); }, closure => sub{ my $w = modify(\&f, \@before, \@around, \@after); }, }; sub combined{ $_->(@_) for @before; around(\&f, @_); $_->(@_) for @after; } print "Calling modified subs:\n"; cmpthese timethese -1 => { modify => sub{ $modified->(42); }, closure => sub{ $closure->(42); }, combined => sub{ combined(42); }, };