File: ProhibitAmbiguousNames.pm

package info (click to toggle)
libperl-critic-perl 1.156-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 3,544 kB
  • sloc: perl: 24,092; lisp: 341; makefile: 7
file content (180 lines) | stat: -rw-r--r-- 4,959 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
package Perl::Critic::Policy::NamingConventions::ProhibitAmbiguousNames;

use 5.010001;
use strict;
use warnings;
use Readonly;

use Perl::Critic::Utils qw{ :severities :data_conversion };
use parent 'Perl::Critic::Policy';

our $VERSION = '1.156';

#-----------------------------------------------------------------------------

Readonly::Scalar my $EXPL => [ 48 ];

Readonly::Scalar my $DEFAULT_FORBID =>
    'abstract bases close contract last left no record right second set';

#-----------------------------------------------------------------------------

sub supported_parameters {
    return (
        {
            name            => 'forbid',
            description     => 'The variable names that are not to be allowed.',
            default_string  => $DEFAULT_FORBID,
            behavior        => 'string list',
        },
    );
}

sub default_severity { return $SEVERITY_MEDIUM         }
sub default_themes   { return qw(core pbp maintenance) }
sub applies_to       { return qw(PPI::Statement::Sub
                                 PPI::Statement::Variable) }

#-----------------------------------------------------------------------------

sub violates {
    my ( $self, $elem, undef ) = @_;

    if ( $elem->isa('PPI::Statement::Sub') ) {
        my @words = grep { $_->isa('PPI::Token::Word') } $elem->schildren();
        for my $word (@words) {

            # strip off any leading "Package::"
            my ($name) = $word =~ m/ (\w+) \z /xms;
            next if not defined $name; # should never happen, right?

            if ( exists $self->{_forbid}->{$name} ) {
                return $self->violation(
                    qq<Ambiguously named subroutine "$name">,
                    $EXPL,
                    $elem,
                );
            }
        }
        return;    # ok
    }

    # PPI::Statement::Variable

    # Accumulate them since there can be more than one violation
    # per variable statement
    my @violations;

    # TODO: false positive bug - this can erroneously catch the
    # assignment half of a variable statement

    my $symbols = $elem->find('PPI::Token::Symbol');
    if ($symbols) {   # this should always be true, right?
        for my $symbol ( @{$symbols} ) {

            # Strip off sigil and any leading "Package::"
            # Beware that punctuation vars may have no
            # alphanumeric characters.

            my ($name) = $symbol =~ m/ (\w+) \z /xms;
            next if ! defined $name;

            if ( exists $self->{_forbid}->{$name} ) {
                push
                    @violations,
                    $self->violation(
                        qq<Ambiguously named variable "$name">,
                        $EXPL,
                        $elem,
                    );
            }
        }
    }

    return @violations;
}

1;

__END__

#-----------------------------------------------------------------------------

=pod

=for stopwords bioinformatics

=head1 NAME

Perl::Critic::Policy::NamingConventions::ProhibitAmbiguousNames - Don't use vague variable or subroutine names like 'last' or 'record'.


=head1 AFFILIATION

This Policy is part of the core L<Perl::Critic|Perl::Critic>
distribution.


=head1 DESCRIPTION

Conway lists a collection of English words which are highly ambiguous
as variable or subroutine names.  For example, C<$last> can mean
previous or final.

This policy tests against a list of ambiguous words for variable
names.


=head1 CONFIGURATION

The default list of forbidden words is:

    abstract bases close contract last left no record right second set

This list can be changed by giving a value for C<forbid> of a series
of forbidden words separated by spaces.

For example, if you decide that C<bases> is an OK name for variables
(e.g.  in bioinformatics), then put something like the following in
C<$HOME/.perlcriticrc>:

    [NamingConventions::ProhibitAmbiguousNames]
    forbid = last set left right no abstract contract record second close


=head1 BUGS

Currently this policy checks the entire variable and subroutine name,
not parts of the name.  For example, it catches C<$last> but not
C<$last_record>.  Hopefully future versions will catch both cases.

Some variable statements will be false positives if they have
assignments where the right hand side uses forbidden names.  For
example, in this case the C<last> incorrectly triggers a violation.

    my $previous_record = $Foo::last;


=head1 AUTHOR

Chris Dolan <cdolan@cpan.org>


=head1 COPYRIGHT

Copyright (c) 2005-2011 Chris Dolan.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.  The full text of this license
can be found in the LICENSE file included with this module.

=cut

# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 78
#   indent-tabs-mode: nil
#   c-indentation-style: bsd
# End:
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :