before, after, around

diff --git a/lib/MooseX/Role/Parameterized.pm b/lib/MooseX/Role/Parameterized.pm
index 2db4d16..3095975 100644 (file)
--- a/lib/MooseX/Role/Parameterized.pm
+++ b/lib/MooseX/Role/Parameterized.pm
@@ -2,7 +2,8 @@
 package MooseX::Role::Parameterized;
 use Moose (
     extends => { -as => 'moose_extends' },
-    qw/around confess/,
+    around => { -as => 'moose_around' },
+    'confess',
 );
 
 use Carp 'croak';
@@ -15,7 +16,7 @@ our $CURRENT_METACLASS;
 
 __PACKAGE__->setup_import_methods(
     with_caller => ['parameter', 'role', 'method'],
-    as_is       => ['has', 'with', 'extends', 'requires', 'excludes', 'augment', 'inner'],
+    as_is       => ['has', 'with', 'extends', 'requires', 'excludes', 'augment', 'inner', 'before', 'after', 'around'],
 );
 
 sub parameter {
@@ -44,7 +45,7 @@ sub init_meta {
 }
 
 # give role a (&) prototype
-around _make_wrapper => sub {
+moose_around _make_wrapper => sub {
     my $orig = shift;
     my ($self, $caller, $sub, $fq_name) = @_;
 
@@ -84,6 +85,51 @@ sub method {
     $CURRENT_METACLASS->add_method($name => $method);
 }
 
+sub before {
+    confess "before must be called within the role { ... } block."
+        unless $CURRENT_METACLASS;
+
+    my $code = pop @_;
+
+    for (@_) {
+        croak "Roles do not currently support "
+            . ref($_)
+            . " references for before method modifiers"
+            if ref $_;
+        $CURRENT_METACLASS->add_before_method_modifier($_, $code);
+    }
+}
+
+sub after {
+    confess "after must be called within the role { ... } block."
+        unless $CURRENT_METACLASS;
+
+    my $code = pop @_;
+
+    for (@_) {
+        croak "Roles do not currently support "
+            . ref($_)
+            . " references for after method modifiers"
+            if ref $_;
+        $CURRENT_METACLASS->add_after_method_modifier($_, $code);
+    }
+}
+
+sub around {
+    confess "around must be called within the role { ... } block."
+        unless $CURRENT_METACLASS;
+
+    my $code = pop @_;
+
+    for (@_) {
+        croak "Roles do not currently support "
+            . ref($_)
+            . " references for around method modifiers"
+            if ref $_;
+        $CURRENT_METACLASS->add_around_method_modifier($_, $code);
+    }
+}
+
 sub with {
     confess "with must be called within the role { ... } block."
         unless $CURRENT_METACLASS;

diff --git a/t/008-method-modifers.t b/t/008-method-modifers.t
new file mode 100644 (file)
index 0000000..2380db4
--- /dev/null
+++ b/t/008-method-modifers.t
@@ -0,0 +1,51 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 2;
+
+my @calls;
+
+do {
+    package MyRole::LogMethod;
+    use MooseX::Role::Parameterized;
+
+    parameter method => (
+        is       => 'ro',
+        isa      => 'Str',
+        required => 1,
+    );
+
+    role {
+        my $p = shift;
+
+        before $p->method => sub {
+            push @calls, "calling " . $p->method
+        };
+
+        after $p->method => sub {
+            push @calls, "called " . $p->method
+        };
+
+        around $p->method => sub {
+            my $orig = shift;
+            my $start = 0; # time
+            $orig->(@_);
+            my $end = 0; # time
+
+            push @calls, "took " . ($end - $start) . " seconds";
+        };
+    };
+};
+
+do {
+    package MyClass;
+    use Moose;
+    with 'MyRole::LogMethod' => {
+        method => 'new',
+    };
+};
+
+is_deeply([splice @calls], [], "no calls yet");
+MyClass->new;
+is_deeply([splice @calls], ["calling new", "took 0 seconds", "called new"], "instrumented new");
+