Attribute::Handlers to wrap a function
Attribute Handlers in Perl are like decorators in Python
examples/attributes/wrap_function.pl
use strict; use warnings; use 5.010; use Attribute::Handlers; sub Wrap : ATTR(CODE) { my ($package, $symbol, $referent, $attr, $data, $phase, $filename, $linenumber) = @_; my $function_name = *{$symbol}{NAME}; my $new = sub { my $params = join ', ', @_; print "Before $function_name($params)\n"; my @results = $referent->(@_); print "After $function_name($params) resulting in: (@results)\n"; return @results; }; no warnings qw(redefine); *$symbol = $new; } sub sum :Wrap { my $sum = 0; $sum += $_ for @_; return $sum; } say sum(2, 3); say sum(-1, 1, 7);
Output:
Before sum(2, 3) After sum(2, 3) resulting in: (5) 5 Before sum(-1, 1, 7) After sum(-1, 1, 7) resulting in: (7) 7
The Wrap function is marked to be a attribute handler for subroutines (CODE).
Inside we create a new anonymous subroutine and assign it to the variable $new and the replace (redefine) the original function with this new function.
Inside the new function we call the original function by
my @results = $referent->(@_);
Before that we execute some code then after the original function returned we execute some code.
Then there is a totally ordinary function called "sub" that is marked with our new "Wrap".
Now every time we call sum() our "$new" function is going to be called.
Separating Attribute to module
Probably you'd like to make your wrapper more reusable and move it out to a module:
examples/attributes/MyWrapper.pm
package MyWrapper; use strict; use warnings; use Attribute::Handlers; sub Wrap : ATTR(CODE) { my ($package, $symbol, $referent, $attr, $data, $phase, $filename, $linenumber) = @_; my $function_name = *{$symbol}{NAME}; my $new = sub { my $params = join ', ', @_; print "Before $function_name($params)\n"; my @results = $referent->(@_); print "After $function_name($params) resulting in: (@results)\n"; return @results; }; no warnings qw(redefine); *$symbol = $new; } 1;
Then, as far as I could figure out you need to "inherit" from that module using base:
examples/attributes/wrap_function_from_module.pl
use strict; use warnings; use 5.010; use base 'MyWrapper'; sub sum :Wrap { my $sum = 0; $sum += $_ for @_; return $sum; } say sum(2, 3); say sum(-1, 1, 7);
perl -I. wrap_function_from_module.pl
Wrapping recursive function
Wrapping a recursive function can help us see the calls that were made to it and the values it returned.
examples/attributes/wrap_function.pl
use strict; use warnings; use 5.010; use Attribute::Handlers; sub Wrap : ATTR(CODE) { my ($package, $symbol, $referent, $attr, $data, $phase, $filename, $linenumber) = @_; my $function_name = *{$symbol}{NAME}; my $new = sub { my $params = join ', ', @_; print "Before $function_name($params)\n"; my @results = $referent->(@_); print "After $function_name($params) resulting in: (@results)\n"; return @results; }; no warnings qw(redefine); *$symbol = $new; } sub sum :Wrap { my $sum = 0; $sum += $_ for @_; return $sum; } say sum(2, 3); say sum(-1, 1, 7);
Output:
Before fibonacci(4) Before fibonacci(3) Before fibonacci(2) Before fibonacci(1) After fibonacci(1) resulting in: (1) Before fibonacci(0) After fibonacci(0) resulting in: (1) After fibonacci(2) resulting in: (2) Before fibonacci(1) After fibonacci(1) resulting in: (1) After fibonacci(3) resulting in: (2) Before fibonacci(2) Before fibonacci(1) After fibonacci(1) resulting in: (1) Before fibonacci(0) After fibonacci(0) resulting in: (1) After fibonacci(2) resulting in: (2) After fibonacci(4) resulting in: (2)
Wrapper to measure elapsed time
Another example is a wrapper that measures the elapsed time in the real function.
examples/attributes/MyTimer.pm
package MyTimer; use strict; use warnings; use 5.010; use Time::HiRes qw(time); use Attribute::Handlers; sub Timer :ATTR(CODE) { my ($package, $symbol, $referent, $attr, $data, $phase, $filename, $linenumber) = @_; my $new = sub { my $start = time; my @results = $referent->(@_); my $end = time; say "Elapsed time: " . ($end-$start); return @results; }; no warnings qw(redefine); *$symbol = $new; } 1;
This is how we use it:
examples/attributes/wrap_function_time.pl
use strict; use warnings; use 5.010; use Time::HiRes qw(time); use base 'MyTimer'; sub sum :Timer { my $sum = 0; $sum += $_ for @_; return $sum; } say sum(2, 3);
This is the output:
$ perl -I. wrap_function_time.pl Elapsed time: 4.05311584472656e-06 5
Published on 2021-04-09