Add has_x_method_modifiers, but not yet tested

[gitmo/Mouse.git] / lib / Mouse / Meta / Role.pm

diff --git a/lib/Mouse/Meta/Role.pm b/lib/Mouse/Meta/Role.pm
index ff0c439..35bc9ea 100644 (file)
--- a/lib/Mouse/Meta/Role.pm
+++ b/lib/Mouse/Meta/Role.pm
@@ -39,6 +39,9 @@ sub _new {
     bless \%args, $class;
 }
 
+sub get_roles { $_[0]->{roles} }
+
+
 sub add_required_methods {
     my $self = shift;
     my @methods = @_;
@@ -219,6 +222,11 @@ for my $modifier_type (qw/before after around override/) {
         push @{ $self->{$modifier}->{$method_name} ||= [] }, $method;
         return;
     };
+    my $has_method_modifiers = sub{
+        my($self, $method_name) = @_;
+        my $m = $self->{$modifier}->{$method_name};
+        return $m && @{$m} != 0;
+    };
     my $get_method_modifiers = sub {
         my ($self, $method_name) = @_;
         return @{ $self->{$modifier}->{$method_name} ||= [] }
@@ -226,11 +234,10 @@ for my $modifier_type (qw/before after around override/) {
 
     no strict 'refs';
     *{ 'add_' . $modifier_type . '_method_modifier'  } = $add_method_modifier;
+    *{ 'has_' . $modifier_type . '_method_modifiers' } = $has_method_modifiers;
     *{ 'get_' . $modifier_type . '_method_modifiers' } = $get_method_modifiers;
 }
 
-sub get_roles { $_[0]->{roles} }
-
 # This is currently not passing all the Moose tests.
 sub does_role {
     my ($self, $role_name) = @_;