How can I apply a Moose method modifier to a method based on a method attribute? - perl

Question

I want to apply a Moose 'before' method modifier to a number of methods in my class. I want to provide the modifier method in a role. I can do it a bit like this:
package MyApp::Role;
use Moose::Role
before [qw(foo bar)] => sub {
...
};
package MyApp;
use Moose;
with (MyApp::Role);
sub foo { ... }
sub bar { ... }
sub baz { ... } # this method is unaffected
However, having to maintain the list of relevant methods in the role ties it to the consuming class and that just seems wrong. I would like to do it a smarter way, like with method attributes:
package MyApp;
use Moose;
with (MyApp::Role);
sub foo :SomeFlag { ... }
sub bar :SomeFlag { ... }
sub baz { ... } # this method is unaffected
I'm not familiar with how to identify method attributes or how I would dynamically apply method modifiers to them.
Or, maybe there is a better way of doing this?

Answer 1

Let's use Attribute::Handlers for this – a fairly sane way to use attributes. We must define a function in a base class which itself has the attribute :ATTR(CODE). This takes a number of arguments:
The package where the sub (or other variable) comes from.
A globref, or the string ANON.
A reference to the value (here: coderef).
The name of the attribute.
Optional data for the attribute.
The (compilation) phase where the attribute was invoked.
The filename where the sub was declared.
The line number where the sub was declared.
So what we can do is to write a handler that applies a before:
use strict; use warnings; use feature 'say';
BEGIN {
package MyRole;
use Moose::Role;
use Attribute::Handlers;
sub SomeFlag :ATTR(CODE) {
my ($package, $globref, $code, $attr, $data, $phase, $filename, $line) = #_;
ref($globref) eq 'GLOB'
or die "Only global subroutines can be decorated with :SomeFlag"
. " at $filename line $line.\n";
# use the MOP to install the method modifier
$package->meta->add_before_method_modifier(
*$globref{NAME} => sub {
warn "Just about to call a flagged sub!";
},
);
}
}
BEGIN {
package MyApp;
use Moose;
# important: SomeFlag must be available before the attrs are handled (CHECK phase)
BEGIN { with 'MyRole' };
sub foo :SomeFlag { say "Hi from foo sub!" }
sub bar :SomeFlag { say "Hi from bar sub!" }
sub baz { say "Hi from baz sub!" }
}
package main;
my $o = MyApp->new;
$o->$_ for qw/foo bar baz/;
I stuffed all of this into a single file, but that obviously isn't neccessary (just add the required uses).
Output:
Just about to call a flagged sub! at so.pl line 16.
Hi from foo sub!
Just about to call a flagged sub! at so.pl line 16.
Hi from bar sub!
Hi from baz sub!