Remove dated comment

[gitmo/Perl-Critic-Dynamic-Moose.git] / lib / Perl / Critic / Policy / DynamicMoose / ClassOverridesRole.pm

diff --git a/lib/Perl/Critic/Policy/DynamicMoose/ClassOverridesRole.pm b/lib/Perl/Critic/Policy/DynamicMoose/ClassOverridesRole.pm
index 361b55f..94b19dd 100644 (file)
--- a/lib/Perl/Critic/Policy/DynamicMoose/ClassOverridesRole.pm
+++ b/lib/Perl/Critic/Policy/DynamicMoose/ClassOverridesRole.pm
@@ -1,17 +1,43 @@
 package Perl::Critic::Policy::DynamicMoose::ClassOverridesRole;
 use Moose;
-extends 'Perl::Critic::Policy::DynamicMoose';
+extends 'Perl::Critic::DynamicMoosePolicy';
 
 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;
+
+    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);
+            next if $application->is_method_aliased($method);
+
+            my $method_object = $class->get_method($method)
+                or next;
+
+            if ($method_object->isa('Moose::Meta::Role::Method')) {
+                next if $method_object->original_package_name eq $role->name;
+            }
+
+            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;
+    return @violations;
 }
 
 no Moose;