Python's decorators in Perl

Python's decorator is some syntax sugar for wrapping functions by another functions:

def bold(func):
    def wrapper(str):
        return '<b>' + func(str) + '</b>'
    return wrapper

def div_id(id):
def decorator(func):
def wrapper(str):
return (('<div id="%s">' % id) + func(str) + '</div>')
return wrapper
return decorator

@div_id("testid")
@bold
def p(str):
return '<p>' + str + '</p>'

print p("test")

And you know what? There is Python::Decorator module which mimics this exact syntax:

use v5.14;
use Python::Decorator;

sub bold {
my ($orig) = @_;
return sub {
return '<b>' . $orig->(@_) . '</b>';
};
}

sub div_id {
my ($id) = @_;
return sub {
my ($orig) = @_;
return sub {
return "<div id=\"$id\">" . $orig->(@_) . '</div>';
};
};
}

@div_id("testid")
@bold
sub p {
my ($str) = @_;
return "<p>$str</p>";
};

say p('test');

This is a proof of concept rather than code for production. I wouldn't use source filter which calls PPI parser, but the idea is very nice. Only if the Perl could do this in more perlish way...

But wait, we have wonderful Moose with its method modifiers and it is really clear now that Python's decorator is simple "around" modifier.

There is my proof of concept which defined new keyword "decorate".

use v5.14;

use Moose;

sub bold {
my ($orig, $self, @args) = @_;
return '<b>' . $self->$orig(@args) . '</b>';
};

sub div_id {
my ($id) = @_;
return sub {
my ($orig, $self, @args) = @_;
return "<div id=\"$id\">" . $self->$orig(@args) . '</div>';
}
}


# new keyword
sub decorate ($@) {
my ($name, @decorators) = @_;
while (my $decorator = pop @decorators) {
my $body = ref $decorator eq 'CODE' ? $decorator : __PACKAGE__->meta->get_method($decorator)->body;
Moose::Util::add_method_modifier(__PACKAGE__, 'around', [ [ $name ], $body ]);
}
}


sub p {
my ($str) = @_;
return "<p>$str</p>";
};

decorate p => div_id('testid'), 'bold';

say p('test');

I wonder if it is worth of own MooseX module. Nevertheless, this pattern can be useful if you want to port some Python code.

3 Comments

Or you could use an attribute

sub p :bold :div_id("testid") {
   my ($str) = @_;
   return "

$str

"; }

Attributes can modify the code in-place, and replace it with a wrapped version

Attributes are isa-scoped. So you can define them in package X, and then use them not only in X, but also in any package that inherits from X. (The gotcha is to make sure you declare inheritance at compile-time rather than run-time.)

Leave a comment

About Piotr Roszatycki

user-pic I blog about Perl.