From: Shawn M Moore <sartak@gmail.com>
Date: Sun, 3 May 2009 19:17:45 +0000 (-0400)
Subject: Implementation of ClassOverridesRole
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=34b35078cf8044d41f2beef4ed661375763c5f0c;p=gitmo%2FPerl-Critic-Dynamic-Moose.git

Implementation of ClassOverridesRole
---

diff --git a/lib/Perl/Critic/Policy/DynamicMoose/ClassOverridesRole.pm b/lib/Perl/Critic/Policy/DynamicMoose/ClassOverridesRole.pm
index b373f84..5fa76da 100644
--- a/lib/Perl/Critic/Policy/DynamicMoose/ClassOverridesRole.pm
+++ b/lib/Perl/Critic/Policy/DynamicMoose/ClassOverridesRole.pm
@@ -4,17 +4,39 @@ extends 'Perl::Critic::Policy::DynamicMoose';
 
 use Perl::Critic::Utils ':severities';
 
-Readonly::Scalar my $EXPL => q{};
+Readonly::Scalar my $EXPL => q{Explicitly exclude overriden methods};
 sub default_severity { $SEVERITY_MEDIUM }
 
 # Class::MOP::Class has no roles
 sub applies_to_metaclass { 'Moose::Meta::Class' }
 
 sub violates_metaclass {
-    my $self = shift;
-    my $meta = shift;
+    my $self  = shift;
+    my $class = shift;
 
-    return;
+    my @violations;
+
+    for my $application ($class->role_applications) {
+        my $role = $application->role;
+        for my $method ($role->get_method_list) {
+            next if $application->is_method_excluded($method);
+
+            my $method_object = $class->get_method($method)
+                or next;
+
+            # no metadata, should check source role to make sure it's the
+            # same as $role
+            next if $method_object->isa('Moose::Meta::Role::Method');
+
+            my $class_name = $class->name;
+            my $role_name  = $role->name;
+
+            my $desc = "Class '$class_name' method '$method' implicitly overrides the same method from role '$role_name'";
+            push @violations, $self->violation($desc, $EXPL);
+        }
+    }
+
+    return @violations;
 }
 
 no Moose;