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.
I blog about Perl.
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
It is true: I could use attributes. Even if some of attribute names are already restricted (lvalue, method, locked, shared and unique).
But I'm not sure if attributes are lexicaly scoped? I don't want to define "bold" or "div_id" attribute in any module. I want it only in this one module.
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.)