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

Question

I want to apply the Moose 'before' method modifier to a number of methods in my class. I want to provide a modifier method in a role. I can do it something 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, in order to maintain a list of the appropriate methods in this role, it contacts it with the consumption class, and it just seems wrong. I would like to do this in a smarter way, for example using method attributes:

 package MyApp; use Moose; with (MyApp::Role); sub foo :SomeFlag { ... } sub bar :SomeFlag { ... } sub baz { ... } # this method is unaffected 

I am not familiar with how to identify method attributes or how to dynamically apply method modifiers to them.

Or maybe there is a better way to do this?

Answer 1

To do this, use Attribute::Handlers - a fairly reasonable way to use attributes. We must define a function in a base class that itself has an attribute :ATTR(CODE) . This takes several arguments:

• The package where the sub (or other variable) comes.
• Globref or string ANON .
• A reference to a value (here: coderef).
• Attribute name.
• Additional data for the attribute.
• The phase (compilation) in which the attribute was called.
• The name of the file in which the signature was declared.
• The number of the line in which sub was declared.

So what we can do is write a handler that applies 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 have enclosed all of this in a single file, but this is obviously not necessary (just add the required use s).

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!