File Coverage

blib/lib/Perl/Critic/Policy/NamingConventions/ProhibitAmbiguousNames.pm
Criterion Covered Total %
statement 41 41 100.0
branch 10 12 83.3
condition n/a
subroutine 11 11 100.0
pod 4 5 80.0
total 66 69 95.6


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::NamingConventions::ProhibitAmbiguousNames;
2              
3 40     40   27505 use 5.010001;
  40         195  
4 40     40   300 use strict;
  40         142  
  40         968  
5 40     40   254 use warnings;
  40         128  
  40         1247  
6 40     40   306 use Readonly;
  40         132  
  40         2256  
7              
8 40     40   315 use Perl::Critic::Utils qw{ :severities :data_conversion };
  40         157  
  40         2170  
9 40     40   7096 use parent 'Perl::Critic::Policy';
  40         124  
  40         275  
10              
11             our $VERSION = '1.148';
12              
13             #-----------------------------------------------------------------------------
14              
15             Readonly::Scalar my $EXPL => [ 48 ];
16              
17             Readonly::Scalar my $DEFAULT_FORBID =>
18             'abstract bases close contract last left no record right second set';
19              
20             #-----------------------------------------------------------------------------
21              
22             sub supported_parameters {
23             return (
24             {
25 99     99 0 2126 name => 'forbid',
26             description => 'The variable names that are not to be allowed.',
27             default_string => $DEFAULT_FORBID,
28             behavior => 'string list',
29             },
30             );
31             }
32              
33 94     94 1 477 sub default_severity { return $SEVERITY_MEDIUM }
34 86     86 1 404 sub default_themes { return qw(core pbp maintenance) }
35 39     39 1 148 sub applies_to { return qw(PPI::Statement::Sub
36             PPI::Statement::Variable) }
37              
38             #-----------------------------------------------------------------------------
39              
40             sub violates {
41 117     117 1 295 my ( $self, $elem, undef ) = @_;
42              
43 117 100       514 if ( $elem->isa('PPI::Statement::Sub') ) {
44 8         35 my @words = grep { $_->isa('PPI::Token::Word') } $elem->schildren();
  24         185  
45 8         29 for my $word (@words) {
46              
47             # strip off any leading "Package::"
48 16         54 my ($name) = $word =~ m/ (\w+) \z /xms;
49 16 50       145 next if not defined $name; # should never happen, right?
50              
51 16 100       65 if ( exists $self->{_forbid}->{$name} ) {
52 2         14 return $self->violation(
53             qq<Ambiguously named subroutine "$name">,
54             $EXPL,
55             $elem,
56             );
57             }
58             }
59 6         24 return; # ok
60             }
61              
62             # PPI::Statement::Variable
63              
64             # Accumulate them since there can be more than one violation
65             # per variable statement
66 109         195 my @violations;
67              
68             # TODO: false positive bug - this can erroneously catch the
69             # assignment half of a variable statement
70              
71 109         350 my $symbols = $elem->find('PPI::Token::Symbol');
72 109 50       38660 if ($symbols) { # this should always be true, right?
73 109         232 for my $symbol ( @{$symbols} ) {
  109         291  
74              
75             # Strip off sigil and any leading "Package::"
76             # Beware that punctuation vars may have no
77             # alphanumeric characters.
78              
79 112         400 my ($name) = $symbol =~ m/ (\w+) \z /xms;
80 112 100       1083 next if ! defined $name;
81              
82 111 100       455 if ( exists $self->{_forbid}->{$name} ) {
83 18         83 push
84             @violations,
85             $self->violation(
86             qq<Ambiguously named variable "$name">,
87             $EXPL,
88             $elem,
89             );
90             }
91             }
92             }
93              
94 109         444 return @violations;
95             }
96              
97             1;
98              
99             __END__
100              
101             #-----------------------------------------------------------------------------
102              
103             =pod
104              
105             =for stopwords bioinformatics
106              
107             =head1 NAME
108              
109             Perl::Critic::Policy::NamingConventions::ProhibitAmbiguousNames - Don't use vague variable or subroutine names like 'last' or 'record'.
110              
111              
112             =head1 AFFILIATION
113              
114             This Policy is part of the core L<Perl::Critic|Perl::Critic>
115             distribution.
116              
117              
118             =head1 DESCRIPTION
119              
120             Conway lists a collection of English words which are highly ambiguous
121             as variable or subroutine names. For example, C<$last> can mean
122             previous or final.
123              
124             This policy tests against a list of ambiguous words for variable
125             names.
126              
127              
128             =head1 CONFIGURATION
129              
130             The default list of forbidden words is:
131              
132             abstract bases close contract last left no record right second set
133              
134             This list can be changed by giving a value for C<forbid> of a series
135             of forbidden words separated by spaces.
136              
137             For example, if you decide that C<bases> is an OK name for variables
138             (e.g. in bioinformatics), then put something like the following in
139             C<$HOME/.perlcriticrc>:
140              
141             [NamingConventions::ProhibitAmbiguousNames]
142             forbid = last set left right no abstract contract record second close
143              
144              
145             =head1 BUGS
146              
147             Currently this policy checks the entire variable and subroutine name,
148             not parts of the name. For example, it catches C<$last> but not
149             C<$last_record>. Hopefully future versions will catch both cases.
150              
151             Some variable statements will be false positives if they have
152             assignments where the right hand side uses forbidden names. For
153             example, in this case the C<last> incorrectly triggers a violation.
154              
155             my $previous_record = $Foo::last;
156              
157              
158             =head1 AUTHOR
159              
160             Chris Dolan <cdolan@cpan.org>
161              
162              
163             =head1 COPYRIGHT
164              
165             Copyright (c) 2005-2011 Chris Dolan.
166              
167             This program is free software; you can redistribute it and/or modify
168             it under the same terms as Perl itself. The full text of this license
169             can be found in the LICENSE file included with this module.
170              
171             =cut
172              
173             # Local Variables:
174             # mode: cperl
175             # cperl-indent-level: 4
176             # fill-column: 78
177             # indent-tabs-mode: nil
178             # c-indentation-style: bsd
179             # End:
180             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :