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