File Coverage

blib/lib/Perl/Critic/Policy/Community/WhileDiamondDefaultAssignment.pm
Criterion Covered Total %
statement 40 41 97.5
branch 17 22 77.2
condition 12 17 70.5
subroutine 10 11 90.9
pod 4 5 80.0
total 83 96 86.4


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::Community::WhileDiamondDefaultAssignment;
2              
3 1     1   471 use strict;
  1         3  
  1         32  
4 1     1   5 use warnings;
  1         4  
  1         30  
5              
6 1     1   7 use Perl::Critic::Utils qw(:severities :classification :ppi);
  1         3  
  1         66  
7 1     1   505 use parent 'Perl::Critic::Policy';
  1         2  
  1         7  
8              
9             our $VERSION = 'v1.0.1';
10              
11 1     1   108 use constant DESC => '<>/<<>>/readline/readdir/each result not explicitly assigned in while condition';
  1         3  
  1         98  
12 1     1   7 use constant EXPL => 'When used alone in a while condition, the <>/<<>> operator, readline, readdir, and each functions assign their result to $_, but do not localize it. Assign the result to an explicit lexical variable instead (my $line = <...>, my $dir = readdir ...)';
  1         3  
  1         479  
13              
14 7     7 0 32540 sub supported_parameters { () }
15 32     32 1 494 sub default_severity { $SEVERITY_HIGH }
16 0     0 1 0 sub default_themes { 'community' }
17 7     7 1 186458 sub applies_to { 'PPI::Token::Word' }
18              
19             my %bad_functions = (
20             each => 1,
21             readdir => 1,
22             readline => 1,
23             );
24              
25             sub violates {
26 110     110 1 8718 my ($self, $elem) = @_;
27 110 100 100     287 return () unless $elem eq 'while' or $elem eq 'for';
28            
29 56   50     939 my $next = $elem->snext_sibling || return ();
30            
31             # Detect for (;<>;)
32 56 100       1644 if ($elem eq 'for') {
    50          
33 8 50       108 return () unless $next->isa('PPI::Structure::For');
34 8         71 my @statements = grep { $_->isa('PPI::Statement') } $next->children;
  16         91  
35 8 50       38 return () unless @statements >= 2;
36 8         17 my $middle = $statements[1];
37 8 100 66     53 return $self->violation(DESC, EXPL, $elem) if $middle->schildren
38             and $middle->schild(0)->isa('PPI::Token::QuoteLike::Readline');
39             } elsif ($elem eq 'while') {
40             # while (<>) {} or ... while <>
41 48 100       1175 if ($next->isa('PPI::Structure::Condition')) {
42 24         88 $next = $next->schild(0);
43 24 50 33     406 return () unless defined $next and $next->isa('PPI::Statement');
44 24         64 $next = $next->schild(0);
45 24 50       297 return () unless defined $next;
46             }
47            
48 48 100       199 return $self->violation(DESC, EXPL, $elem) if $next->isa('PPI::Token::QuoteLike::Readline');
49 40 100 100     155 if ($next->isa('PPI::Token::Word') and exists $bad_functions{$next} and is_function_call $next) {
      66        
50 20         5818 return $self->violation(DESC, EXPL, $elem);
51             }
52             }
53            
54 24         266 return ();
55             }
56              
57             1;
58              
59             =head1 NAME
60              
61             Perl::Critic::Policy::Community::WhileDiamondDefaultAssignment - Don't use
62             while with implicit assignment to $_
63              
64             =head1 DESCRIPTION
65              
66             The diamond operator C<E<lt>E<gt>> (or C<E<lt>E<lt>E<gt>E<gt>>), and functions
67             C<readline()>, C<readdir()>, and C<each()> are extra magical in a while
68             condition: if it is the only thing in the condition, it will assign its result
69             to C<$_>, but it does not localize C<$_> to the while loop. (Note, this also
70             applies to a C<for (;E<lt>E<gt>;)> construct.) This can unintentionally confuse
71             outer loops that are already using C<$_> to iterate. In addition, using C<$_>
72             at all means that your loop can get confused by other code which does not
73             politely localize its usage of the global variable. To avoid these
74             possibilities, assign the result of the diamond operator or these functions to
75             an explicit lexical variable.
76              
77             while (<$fh>) { ... } # not ok
78             while (<<>>) { ... } # not ok
79             ... while <STDIN>; # not ok
80             for (;<>;) { ... } # not ok
81             while (readline $fh) { ... } # not ok
82             while (readdir $dh) { ... } # not ok
83              
84             while (my $line = <$fh>) { ... } # ok
85             while (my $line = <<>>) { ... } # ok
86             ... while $line = <STDIN>; # ok
87             for (;my $line = <>;) { ... } # ok
88             while (my $line = readline $fh) { ... } # ok
89             while (my $dir = readdir $dh) { ... } # ok
90              
91             =head1 AFFILIATION
92              
93             This policy is part of L<Perl::Critic::Community>.
94              
95             =head1 CONFIGURATION
96              
97             This policy is not configurable except for the standard options.
98              
99             =head1 AUTHOR
100              
101             Dan Book, C<dbook@cpan.org>
102              
103             =head1 COPYRIGHT AND LICENSE
104              
105             Copyright 2015, Dan Book.
106              
107             This library is free software; you may redistribute it and/or modify it under
108             the terms of the Artistic License version 2.0.
109              
110             =head1 SEE ALSO
111              
112             L<Perl::Critic>