git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/NamingConventions/ProhibitAmbiguousNames.pm

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