vcs.maemo.org Git - dh-make-perl/blob - dev/i386/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/Variables/RequireLocalizedPunctuationVars.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/Variables/RequireLocalizedPunctuationVars.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::RequireLocalizedPunctuationVars;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15 use Perl::Critic::Utils qw{ :severities :classification hashify};
  16 use base 'Perl::Critic::Policy';
  17
  18 our $VERSION = '1.088';
  19
  20 #-----------------------------------------------------------------------------
  21
  22 Readonly::Scalar my $PACKAGE_RX => qr/::/mx;
  23 Readonly::Hash   my %EXCEPTIONS => hashify(qw(
  24     $_
  25     $ARG
  26     @_
  27 ));
  28 Readonly::Scalar my $DESC => q{Magic variables should be assigned as "local"};
  29 Readonly::Scalar my $EXPL => [ 81, 82 ];
  30
  31 #-----------------------------------------------------------------------------
  32
  33 sub supported_parameters { return ()                         }
  34 sub default_severity     { return $SEVERITY_HIGH             }
  35 sub default_themes       { return qw(core pbp bugs)          }
  36 sub applies_to           { return 'PPI::Token::Operator'     }
  37
  38 #-----------------------------------------------------------------------------
  39
  40 sub violates {
  41     my ( $self, $elem, undef ) = @_;
  42
  43     return if $elem ne q{=};
  44
  45     my $destination = $elem->sprevious_sibling;
  46     return if !$destination;  # huh? assignment in void context??
  47
  48     if (_is_non_local_magic_dest($destination)) {
  49        return $self->violation( $DESC, $EXPL, $elem );
  50     }
  51     return;  # OK
  52 }
  53
  54 sub _is_non_local_magic_dest {
  55     my $elem = shift;
  56
  57     #print "Test dest $elem, @{[ref $elem]}\n";
  58
  59     # Quick exit if in good form
  60     my $modifier = $elem->sprevious_sibling;
  61     return
  62         if
  63                 $modifier
  64             &&  $modifier->isa('PPI::Token::Word')
  65             &&  ($modifier eq 'local' || $modifier eq 'my');
  66
  67     # Implementation note: Can't rely on PPI::Token::Magic,
  68     # unfortunately, because we need English too
  69
  70     if ($elem->isa('PPI::Token::Symbol')) {
  71         return _is_magic_var($elem);
  72     } elsif ($elem->isa('PPI::Structure::List') || $elem->isa('PPI::Statement::Expression')) {
  73         for my $child ($elem->schildren) {
  74             return 1 if _is_non_local_magic_dest($child);
  75         }
  76     }
  77
  78     return;
  79 }
  80
  81 #-----------------------------------------------------------------------------
  82
  83 sub _is_magic_var {
  84     my ($elem) = @_;
  85
  86     my $variable_name = "$elem";
  87     return if $EXCEPTIONS{$variable_name};
  88     return 1 if $elem->isa('PPI::Token::Magic'); # optimization(?), and helps with PPI 1.118 carat bug
  89     return if ! is_perl_global( $elem );
  90
  91     return 1;
  92 }
  93
  94 1;
  95
  96 __END__
  97
  98 #-----------------------------------------------------------------------------
  99
 100 =pod
 101
 102 =head1 NAME
 103
 104 Perl::Critic::Policy::Variables::RequireLocalizedPunctuationVars - Magic variables should be assigned as "local".
 105
 106 =head1 AFFILIATION
 107
 108 This Policy is part of the core L<Perl::Critic> distribution.
 109
 110
 111 =head1 DESCRIPTION
 112
 113 Punctuation variables (and their English.pm equivalents) are global
 114 variables.  Messing with globals is dangerous in a complex program as
 115 it can lead to very subtle and hard to fix bugs.  If you must change a
 116 magic variable in a non-trivial program, do it in a local scope.
 117
 118 For example, to slurp a filehandle into a scalar, it's common to set
 119 the record separator to undef instead of a newline.  If you choose to
 120 do this (instead of using L<File::Slurp>!) then be sure to localize
 121 the global and change it for as short a time as possible.
 122
 123    # BAD:
 124    $/ = undef;
 125    my $content = <$fh>;
 126
 127    # BETTER:
 128    my $content;
 129    {
 130        local $/ = undef;
 131        $content = <$fh>;
 132    }
 133
 134    # A popular idiom:
 135    my $content = do { local $/ = undef; <$fh> };
 136
 137 This policy also allows the use of C<my>.  Perl prevents using C<my>
 138 with "proper" punctuation variables, but allows C<$a>, C<@ARGV>, the
 139 names declared by L<English>, etc.  This is not a good coding
 140 practice, however it is not the concern of this specific policy to
 141 complain about that.
 142
 143
 144 =head1 CONFIGURATION
 145
 146 This Policy is not configurable except for the standard options.
 147
 148
 149 =head1 CAVEATS
 150
 151 The current PPI (v1.118) has a bug where $^ variables absorb following
 152 whitespace by mistake.  This makes it harder to spot those as magic
 153 variables.  Hopefully this will be fixed by PPI 1.200.  In the
 154 meantime, we have a workaround in this module.
 155
 156 Additionally, PPI v1.118 fails to recognize %! and %^H as magic
 157 variables.  PPI instead sees the "%" as a modulus operator.  We have
 158 no workaround for that bug right now.
 159
 160 =head1 CREDITS
 161
 162 Initial development of this policy was supported by a grant from the
 163 Perl Foundation.
 164
 165 =head1 AUTHOR
 166
 167 Chris Dolan <cdolan@cpan.org>
 168
 169 =head1 COPYRIGHT
 170
 171 Copyright (c) 2007-2008 Chris Dolan.  Many rights reserved.
 172
 173 This program is free software; you can redistribute it and/or modify
 174 it under the same terms as Perl itself.  The full text of this license
 175 can be found in the LICENSE file included with this module.
 176
 177 =cut
 178
 179 # Local Variables:
 180 #   mode: cperl
 181 #   cperl-indent-level: 4
 182 #   fill-column: 78
 183 #   indent-tabs-mode: nil
 184 #   c-indentation-style: bsd
 185 # End:
 186 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :