Don't use get_method_map either
[gitmo/Perl-Critic-Dynamic-Moose.git] / lib / Perl / Critic / Policy / DynamicMoose / RequireMethodModifiers.pm
1 package Perl::Critic::Policy::DynamicMoose::RequireMethodModifiers;
2 use Moose;
3 extends 'Perl::Critic::Policy::DynamicMoose';
4
5 use Perl::Critic::Utils ':severities';
6 use Perl::Critic::Utils::Moose 'meta_type';
7
8 Readonly::Scalar my $EXPL => q{Method modifiers make it clear that you're overriding methods.};
9 sub default_severity { $SEVERITY_LOW }
10
11 sub violates_metaclass {
12     my $self = shift;
13     my $meta = shift;
14
15     my @violations;
16
17     for my $name ($meta->get_method_list) {
18         my $method = $meta->get_method($name);
19
20         # override and augment modifiers are always fine.
21         next if $method->isa('Moose::Meta::Method::Overridden')
22              || $method->isa('Moose::Meta::Method::Augmented');
23
24         # Since we can implicitly override and wrap in the same class, we
25         # need to be a little more careful here.
26         if ($method->isa('Class::MOP::Method::Wrapped')) {
27             my $orig_method = $method->get_original_method;
28             next if $method->associated_metaclass->name
29                  ne $orig_method->associated_metaclass->name;
30         }
31
32         # Generated methods
33         next if $method->isa('Class::MOP::Method::Generated');
34
35         # XXX: this freaking sucks
36         next if $name eq 'meta' || $name eq 'BUILD' || $name eq 'DEMOLISH';
37
38         my $next = $meta->find_next_method_by_name($name);
39
40         # Adding new methods is always fine.
41         next if !$next;
42
43         push @violations, $self->violation("The '$name' method of class " . $meta->name . " does not use a method modifier to override its superclass implementation.", $EXPL);
44     }
45
46     return @violations;
47 }
48
49 no Moose;
50
51 1;
52
53 __END__
54
55 =head1 NAME
56
57 Perl::Critic::Policy::DynamicMoose::RequireMethodModifiers
58
59 =head1 DESCRIPTION
60
61
62 =head1 WARNING
63
64 B<VERY IMPORTANT:> Most L<Perl::Critic> Policies (including all the ones that
65 ship with Perl::Critic> use pure static analysis -- they never compile nor
66 execute any of the code that they analyze.  However, this policy is very
67 different.  It actually attempts to compile your code and then compares the
68 subroutines mentioned in your code to those found in the symbol table.
69 Therefore you should B<not> use this Policy on any code that you do not trust,
70 or may have undesirable side-effects at compile-time (such as connecting to the
71 network or mutating files).
72
73 For this Policy to work, all the modules included in your code must be
74 installed locally, and must compile without error.
75
76 =head1 AUTHOR
77
78 Shawn M Moore, C<sartak@bestpractical.com>
79
80 =cut
81