File Coverage

blib/lib/Perl/Critic/Policy/Variables/RequireLocalizedPunctuationVars.pm
Criterion Covered Total %
statement 39 46 84.7
branch 11 24 45.8
condition 5 9 55.5
subroutine 13 13 100.0
pod 4 5 80.0
total 72 97 74.2


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::Variables::RequireLocalizedPunctuationVars;
2              
3 40     40   27412 use 5.010001;
  40         224  
4 40     40   277 use strict;
  40         141  
  40         906  
5 40     40   286 use warnings;
  40         133  
  40         1050  
6 40     40   253 use Readonly;
  40         158  
  40         2156  
7              
8 40     40   289 use Perl::Critic::Utils qw{ :severities :classification $EMPTY hashify};
  40         133  
  40         2159  
9 40     40   14569 use parent 'Perl::Critic::Policy';
  40         154  
  40         249  
10              
11             our $VERSION = '1.150';
12              
13             #-----------------------------------------------------------------------------
14              
15             Readonly::Scalar my $DESC => q{Magic variable "%s" should be assigned as "local"};
16             Readonly::Scalar my $EXPL => [ 81, 82 ];
17              
18             #-----------------------------------------------------------------------------
19              
20             sub supported_parameters {
21             return (
22             {
23 90     90 0 2250 name => 'allow',
24             description =>
25             q<Global variables to exclude from this policy.>,
26             default_string => $EMPTY,
27             behavior => 'string list',
28             list_always_present_values => [ qw< $_ $ARG @_ > ],
29             },
30             );
31             }
32              
33 74     74 1 296 sub default_severity { return $SEVERITY_HIGH }
34 92     92 1 423 sub default_themes { return qw(core pbp bugs certrec ) }
35 32     32 1 87 sub applies_to { return 'PPI::Token::Operator' }
36              
37             #-----------------------------------------------------------------------------
38              
39             sub violates {
40 139     139 1 315 my ( $self, $elem, undef ) = @_;
41              
42 139 100       305 return if $elem->content() ne q{=};
43              
44 118         662 my $destination = $elem->sprevious_sibling;
45 118 50       2756 return if !$destination; # huh? assignment in void context??
46 118         438 while ($destination->isa('PPI::Structure::Subscript')) {
47 0 0       0 $destination = $destination->sprevious_sibling()
48             or return;
49             }
50              
51 118 50       290 if (my $var = $self->_is_non_local_magic_dest($destination)) {
52 0         0 return $self->violation( sprintf( $DESC, $var ), $EXPL, $elem );
53             }
54 118         1031 return; # OK
55             }
56              
57             sub _is_non_local_magic_dest {
58 118     118   227 my ($self, $elem) = @_;
59              
60 118         212 state $local_or_my = { hashify( 'local', 'my' ) };
61              
62             # Quick exit if in good form
63 118         232 my $modifier = $elem->sprevious_sibling;
64             return
65             if
66             $modifier
67             && $modifier->isa('PPI::Token::Word')
68 118 100 66     2418 && $local_or_my->{$modifier->content()};
      100        
69              
70             # Implementation note: Can't rely on PPI::Token::Magic,
71             # unfortunately, because we need English too
72              
73 57 50 0     293 if ($elem->isa('PPI::Token::Symbol')) {
    0          
74 57 50       214 return $self->_is_magic_var($elem) ? $elem : undef;
75             }
76             elsif (
77             $elem->isa('PPI::Structure::List')
78             or $elem->isa('PPI::Statement::Expression')
79             ) {
80 0         0 for my $child ($elem->schildren) {
81 0         0 my $var = $self->_is_non_local_magic_dest($child);
82 0 0       0 return $var if $var;
83             }
84             }
85              
86 0         0 return;
87             }
88              
89             #-----------------------------------------------------------------------------
90              
91             sub _is_magic_var {
92 57     57   135 my ($self, $elem) = @_;
93              
94 57         183 my $variable_name = $elem->symbol();
95 57 50       2432 return if $self->{_allow}{$variable_name};
96 57 50       261 return 1 if $elem->isa('PPI::Token::Magic'); # optimization(?), and
97             # helps with PPI 1.118 carat
98             # bug. This bug is gone as of
99             # 1.208, which is required for
100             # P::C 1.113. RT 65514
101 57 50       223 return if not is_perl_global( $elem );
102              
103 0           return 1;
104             }
105              
106             1;
107              
108             __END__
109              
110             #-----------------------------------------------------------------------------
111              
112             =pod
113              
114             =head1 NAME
115              
116             Perl::Critic::Policy::Variables::RequireLocalizedPunctuationVars - Magic variables should be assigned as "local".
117              
118              
119             =head1 AFFILIATION
120              
121             This Policy is part of the core L<Perl::Critic|Perl::Critic>
122             distribution.
123              
124              
125             =head1 DESCRIPTION
126              
127             Punctuation variables (and their English.pm equivalents) are global
128             variables. Messing with globals is dangerous in a complex program as
129             it can lead to very subtle and hard to fix bugs. If you must change a
130             magic variable in a non-trivial program, do it in a local scope.
131              
132             For example, to slurp a filehandle into a scalar, it's common to set
133             the record separator to undef instead of a newline. If you choose to
134             do this (instead of using L<Path::Tiny|Path::Tiny>!) then be sure to
135             localize the global and change it for as short a time as possible.
136              
137             # BAD:
138             $/ = undef;
139             my $content = <$fh>;
140              
141             # BETTER:
142             my $content;
143             {
144             local $/ = undef;
145             $content = <$fh>;
146             }
147              
148             # A popular idiom:
149             my $content = do { local $/ = undef; <$fh> };
150              
151             This policy also allows the use of C<my>. Perl prevents using C<my>
152             with "proper" punctuation variables, but allows C<$a>, C<@ARGV>, the
153             names declared by L<English|English>, etc. This is not a good coding
154             practice, however it is not the concern of this specific policy to
155             complain about that.
156              
157             There are exemptions for C<$_> and C<@_>, and the English equivalent
158             C<$ARG>.
159              
160              
161             =head1 CONFIGURATION
162              
163             You can configure your own exemptions using the C<allow> option:
164              
165             [Variables::RequireLocalizedPunctuationVars]
166             allow = @ARGV $ARGV
167              
168             These are added to the default exemptions.
169              
170              
171             =head1 CREDITS
172              
173             Initial development of this policy was supported by a grant from the
174             Perl Foundation.
175              
176              
177             =head1 AUTHOR
178              
179             Chris Dolan <cdolan@cpan.org>
180              
181              
182             =head1 COPYRIGHT
183              
184             Copyright (c) 2007-2011 Chris Dolan. Many rights reserved.
185              
186             This program is free software; you can redistribute it and/or modify
187             it under the same terms as Perl itself. The full text of this license
188             can be found in the LICENSE file included with this module.
189              
190             =cut
191              
192             # Local Variables:
193             # mode: cperl
194             # cperl-indent-level: 4
195             # fill-column: 78
196             # indent-tabs-mode: nil
197             # c-indentation-style: bsd
198             # End:
199             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :