super/override

diff --git a/lib/MooseX/Role/Parameterized.pm b/lib/MooseX/Role/Parameterized.pm
index 3095975..938cc6a 100644 (file)
--- a/lib/MooseX/Role/Parameterized.pm
+++ b/lib/MooseX/Role/Parameterized.pm
@@ -16,7 +16,7 @@ our $CURRENT_METACLASS;
 
 __PACKAGE__->setup_import_methods(
     with_caller => ['parameter', 'role', 'method'],
-    as_is       => ['has', 'with', 'extends', 'requires', 'excludes', 'augment', 'inner', 'before', 'after', 'around'],
+    as_is       => ['has', 'with', 'extends', 'requires', 'excludes', 'augment', 'inner', 'before', 'after', 'around', 'super', 'override'],
 );
 
 sub parameter {
@@ -150,6 +150,20 @@ sub excludes {
     $CURRENT_METACLASS->add_excluded_roles(@_);
 }
 
+# see Moose.pm for discussion
+sub super {
+    return unless $Moose::SUPER_BODY;
+    $Moose::SUPER_BODY->(@Moose::SUPER_ARGS);
+}
+
+sub override {
+    confess "override must be called within the role { ... } block."
+        unless $CURRENT_METACLASS;
+
+    my ($name, $code) = @_;
+    $CURRENT_METACLASS->add_override_method_modifier($name, $code);
+}
+
 sub extends { croak "Roles do not currently support 'extends'" }
 
 sub inner { croak "Roles cannot support 'inner'" }

diff --git a/t/009-override-super.t b/t/009-override-super.t
new file mode 100644 (file)
index 0000000..012ed8b
--- /dev/null
+++ b/t/009-override-super.t
@@ -0,0 +1,40 @@
+#!/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       => 'rw',
+        isa      => 'Str',
+        required => 1,
+    );
+
+    role {
+        my $p = shift;
+
+        override $p->method => sub {
+            push @calls, "calling " . $p->method;
+            super;
+            push @calls, "called " . $p->method;
+        };
+    };
+};
+
+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", "called new"], "instrumented new");
+