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