File Coverage

blib/lib/Perl/Critic/Policy/TooMuchCode/ProhibitDuplicateSub.pm
Criterion Covered Total %
statement 28 29 96.5
branch 6 8 75.0
condition 3 5 60.0
subroutine 6 7 85.7
pod 3 3 100.0
total 46 52 88.4


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::TooMuchCode::ProhibitDuplicateSub;
2 4     4   824773 use strict;
  4         34  
  4         117  
3 4     4   23 use warnings;
  4         9  
  4         97  
4 4     4   22 use Perl::Critic::Utils;
  4         8  
  4         74  
5 4     4   3596 use parent 'Perl::Critic::Policy';
  4         10  
  4         40  
6              
7 0     0 1 0 sub default_themes { return qw( bugs maintenance ) }
8 4     4 1 83995 sub applies_to { return 'PPI::Document' }
9              
10             sub violates {
11 4     4 1 61 my ($self, undef, $doc) = @_;
12 4   100     14 my $packages = $doc->find('PPI::Statement::Package') || [];
13 4 100       101 if (@$packages > 1) {
14 2         9 return ();
15             }
16              
17 2 50       9 my $subdefs = $doc->find('PPI::Statement::Sub') or return;
18              
19 2         27 my %seen;
20             my @duplicates;
21 2         8 for my $sub (@$subdefs) {
22 5 50 33     78 next if $sub->forward || (! $sub->name);
23              
24 5 100       324 if (exists $seen{ $sub->name }) {
25 1         23 push @duplicates, $seen{ $sub->name };
26             }
27 5         110 $seen{ $sub->name } = $sub;
28             }
29              
30             my @violations = map {
31 2         44 my $last_sub = $seen{ $_->name };
  1         4  
32              
33 1         32 $self->violation(
34             "Duplicate subroutine definition. Redefined at line: " . $last_sub->line_number . ", column: " . $last_sub->column_number,
35             "Another subroutine definition latter in the same scope with identical name masks this one.",
36             $_,
37             );
38             } @duplicates;
39              
40 2         427 return @violations;
41             }
42              
43             1;
44              
45             =encoding utf-8
46              
47             =head1 NAME
48              
49             TooMuchCode::ProhibitDuplicateSub - When 2 subroutines are defined with the same name, report the first one.
50              
51             =head1 DESCRIPTION
52              
53             This policy checks if there are subroutine definitions with identical names
54             under the same namespace. If they exists, all but the last one are marked as
55             violation.
56              
57             perl runtime allows a named subroutine to be redefined in the same source file
58             and the latest definition wins. In the event that this is done by developers,
59             preferably unintentionally, perl runtime warns about a subroutine is
60             redefined with the position is for the one that wins. This policy does the
61             opposite.
62              
63             Although the last one is not marked as a violation, it's position is
64             reported together. Making it easier for developer to locate the subroutine.
65              
66             Should the developer decide to programmatically remove the duplicates,
67             simply go through all the violations and remove those statements.
68              
69             =cut