Add has_x_method_modifiers, but not yet tested
gfx [Sun, 20 Sep 2009 07:34:00 +0000 (16:34 +0900)]
lib/Mouse/Meta/Role.pm
lib/Mouse/Object.pm

index 403b781..35bc9ea 100644 (file)
@@ -222,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} ||= [] }
@@ -229,6 +234,7 @@ 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;
 }
 
index 8871a19..47626d3 100644 (file)
@@ -137,13 +137,7 @@ sub does {
     (defined $role_name)
         || confess "You must supply a role name to does()";
 
-    my $meta = $self->meta;
-    foreach my $class ($meta->linearized_isa) {
-        my $m = ref($meta)->initialize($class);
-        return 1
-            if $m->can('does_role') && $m->does_role($role_name);
-    }
-    return 0;
+    return $self->meta->does_role($role_name);
 };
 
 1;