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   28155 use 5.010001;
  40         210  
4 40     40   277 use strict;
  40         111  
  40         840  
5 40     40   263 use warnings;
  40         134  
  40         1266  
6 40     40   295 use Readonly;
  40         130  
  40         2341  
7              
8 40     40   363 use Perl::Critic::Utils qw{ :severities :data_conversion };
  40         127  
  40         2242  
9 40     40   6863 use parent 'Perl::Critic::Policy';
  40         127  
  40         272  
10              
11             our $VERSION = '1.146';
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 2210 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 431 sub default_severity { return $SEVERITY_MEDIUM }
34 86     86 1 426 sub default_themes { return qw(core pbp maintenance) }
35 39     39 1 140 sub applies_to { return qw(PPI::Statement::Sub
36             PPI::Statement::Variable) }
37              
38             #-----------------------------------------------------------------------------
39              
40             sub violates {
41 117     117 1 341 my ( $self, $elem, undef ) = @_;
42              
43 117 100       538 if ( $elem->isa('PPI::Statement::Sub') ) {
44 8         37 my @words = grep { $_->isa('PPI::Token::Word') } $elem->schildren();
  24         180  
45 8         25 for my $word (@words) {
46              
47             # strip off any leading "Package::"
48 16         43 my ($name) = $word =~ m/ (\w+) \z /xms;
49 16 50       145 next if not defined $name; # should never happen, right?
50              
51 16 100       77 if ( exists $self->{_forbid}->{$name} ) {
52 2         12 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         237 my @violations;
67              
68             # TODO: false positive bug - this can erroneously catch the
69             # assignment half of a variable statement
70              
71 109         352 my $symbols = $elem->find('PPI::Token::Symbol');
72 109 50       36942 if ($symbols) { # this should always be true, right?
73 109         250 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         385 my ($name) = $symbol =~ m/ (\w+) \z /xms;
80 112 100       1029 next if ! defined $name;
81              
82 111 100       520 if ( exists $self->{_forbid}->{$name} ) {
83 18         82 push
84             @violations,
85             $self->violation(
86             qq<Ambiguously named variable "$name">,
87             $EXPL,
88             $elem,
89             );
90             }
91             }
92             }
93              
94 109         436 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 :