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

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/Variables/ProhibitPackageVars.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::Variables::ProhibitPackageVars;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13
  14 use Readonly;
  15 use Carp qw( carp );
  16
  17 use List::MoreUtils qw(all);
  18
  19 use Perl::Critic::Utils qw{
  20     :booleans :characters :severities :data_conversion
  21 };
  22 use base 'Perl::Critic::Policy';
  23
  24 our $VERSION = '1.088';
  25
  26 #-----------------------------------------------------------------------------
  27
  28 Readonly::Scalar my $DESC => q{Package variable declared or used};
  29 Readonly::Scalar my $EXPL => [ 73, 75 ];
  30
  31 #-----------------------------------------------------------------------------
  32
  33 sub supported_parameters {
  34     return (
  35         {
  36             name            => 'packages',
  37             description     => 'The base set of packages to allow variables for.',
  38             default_string  => 'File::Find Data::Dumper',
  39             behavior        => 'string list',
  40         },
  41         {
  42             name            => 'add_packages',
  43             description     => 'The set of packages to allow variables for, in addition to those given in "packages".',
  44             default_string  => $EMPTY,
  45             behavior        => 'string list',
  46         },
  47     );
  48 }
  49
  50 sub default_severity { return $SEVERITY_MEDIUM            }
  51 sub default_themes   { return qw(core pbp maintenance)    }
  52 sub applies_to       { return qw(PPI::Token::Symbol
  53                                  PPI::Statement::Variable
  54                                  PPI::Statement::Include) }
  55
  56 Readonly::Array our @DEFAULT_PACKAGE_EXCEPTIONS =>
  57     qw( File::Find Data::Dumper );
  58
  59 #-----------------------------------------------------------------------------
  60
  61 sub initialize_if_enabled {
  62     my ($self, $config) = @_;
  63
  64     $self->{_all_packages} = {
  65         hashify keys %{ $self->{_packages} }, keys %{ $self->{_add_packages} }
  66     };
  67
  68     return $TRUE;
  69 }
  70
  71 #-----------------------------------------------------------------------------
  72
  73 sub violates {
  74     my ( $self, $elem, undef ) = @_;
  75
  76     if ( $self->_is_package_var($elem) ||
  77          _is_our_var($elem)            ||
  78          _is_vars_pragma($elem) )
  79        {
  80
  81         return $self->violation( $DESC, $EXPL, $elem );
  82     }
  83
  84     return;  # ok
  85 }
  86
  87 #-----------------------------------------------------------------------------
  88
  89 sub _is_package_var {
  90     my $self = shift;
  91     my $elem = shift;
  92     return if !$elem->isa('PPI::Token::Symbol');
  93     my ($package, $name) = $elem =~ m{ \A [@\$%] (.*) :: (\w+) \z }mx;
  94     return if not defined $package;
  95     return if _all_upcase( $name );
  96     return if $self->{_all_packages}->{$package};
  97     return 1;
  98 }
  99
 100 #-----------------------------------------------------------------------------
 101
 102 sub _is_our_var {
 103     my $elem = shift;
 104     return if not $elem->isa('PPI::Statement::Variable');
 105     return if $elem->type() ne 'our';
 106     return if _all_upcase( $elem->variables() );
 107     return 1;
 108 }
 109
 110 #-----------------------------------------------------------------------------
 111
 112 sub _is_vars_pragma {
 113     my $elem = shift;
 114     return if !$elem->isa('PPI::Statement::Include');
 115     return if $elem->pragma() ne 'vars';
 116
 117     # Older Perls don't support the C<our> keyword, so we try to let
 118     # people use the C<vars> pragma instead, but only if all the
 119     # variable names are uppercase.  Since there are lots of ways to
 120     # pass arguments to pragmas (e.g. "$foo" or qw($foo) ) we just use
 121     # a regex to match things that look like variables names.
 122
 123     my @varnames = $elem =~ m{ [@\$%&] (\w+) }gmx;
 124
 125     return if !@varnames;   # no valid variables specified
 126     return if _all_upcase( @varnames );
 127     return 1;
 128 }
 129
 130 sub _all_upcase {  ##no critic(ArgUnpacking)
 131     return all { $_ eq uc $_ } @_;
 132 }
 133
 134 1;
 135
 136 __END__
 137
 138 #-----------------------------------------------------------------------------
 139
 140 =pod
 141
 142 =head1 NAME
 143
 144 Perl::Critic::Policy::Variables::ProhibitPackageVars - Eliminate globals declared with C<our> or C<use vars>.
 145
 146 =head1 AFFILIATION
 147
 148 This Policy is part of the core L<Perl::Critic> distribution.
 149
 150
 151 =head1 DESCRIPTION
 152
 153 Conway suggests avoiding package variables completely, because they
 154 expose your internals to other packages.  Never use a package variable
 155 when a lexical variable will suffice.  If your package needs to keep
 156 some dynamic state, consider using an object or closures to keep the
 157 state private.
 158
 159 This policy assumes that you're using C<strict vars> so that naked
 160 variable declarations are not package variables by default.  Thus, it
 161 complains you declare a variable with C<our> or C<use vars>, or if you
 162 make reference to variable with a fully-qualified package name.
 163
 164   $Some::Package::foo = 1;    #not ok
 165   our $foo            = 1;    #not ok
 166   use vars '$foo';            #not ok
 167   $foo = 1;                   #not allowed by 'strict'
 168   local $foo = 1;             #bad taste, but technically ok.
 169   use vars '$FOO';            #ok, because it's ALL CAPS
 170   my $foo = 1;                #ok
 171
 172 In practice though, its not really practical to prohibit all package
 173 variables.  Common variables like C<$VERSION> and C<@EXPORT> need to
 174 be global, as do any variables that you want to Export.  To work
 175 around this, the Policy overlooks any variables that are in ALL_CAPS.
 176 This forces you to put all your exported variables in ALL_CAPS too, which
 177 seems to be the usual practice anyway.
 178
 179 =head1 CONFIGURATION
 180
 181 There is room for exceptions.  Some modules, like the core File::Find
 182 module, use package variables as their only interface, and others
 183 like Data::Dumper use package variables as their most common
 184 interface.  These module can be specified from your F<.perlcriticrc>
 185 file, and the policy will ignore them.
 186
 187     [Variables::ProhibitPackageVars]
 188     packages = File::Find Data::Dumper
 189
 190 This is the default setting.  Using C<packages =>  will override
 191 these defaults.
 192
 193 You can also add packages to the defaults like so:
 194
 195     [Variables::ProhibitPackageVars]
 196     add_packages = My::Package
 197
 198 You can add package C<main> to the list of packages, but that will
 199 only OK variables explicitly in the C<main> package.
 200
 201 =head1 SEE ALSO
 202
 203 L<Perl::Critic::Policy::Variables::ProhibitPunctuationVars>
 204
 205 L<Perl::Critic::Policy::Variables::ProhibitLocalVars>
 206
 207 =head1 AUTHOR
 208
 209 Jeffrey Ryan Thalhammer <thaljef@cpan.org>
 210
 211 =head1 COPYRIGHT
 212
 213 Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer.  All rights reserved.
 214
 215 This program is free software; you can redistribute it and/or modify
 216 it under the same terms as Perl itself.  The full text of this license
 217 can be found in the LICENSE file included with this module.
 218
 219 =cut
 220
 221 # Local Variables:
 222 #   mode: cperl
 223 #   cperl-indent-level: 4
 224 #   fill-column: 78
 225 #   indent-tabs-mode: nil
 226 #   c-indentation-style: bsd
 227 # End:
 228 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :