line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Perl::Critic::Policy::InputOutput::ProhibitHighPrecedentLogicalOperatorErrorHandling; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
1342
|
use 5.006; |
|
2
|
|
|
|
|
7
|
|
4
|
2
|
|
|
2
|
|
11
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
33
|
|
5
|
2
|
|
|
2
|
|
10
|
use warnings; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
51
|
|
6
|
2
|
|
|
2
|
|
942
|
use Readonly; |
|
2
|
|
|
|
|
6587
|
|
|
2
|
|
|
|
|
97
|
|
7
|
|
|
|
|
|
|
|
8
|
2
|
|
|
2
|
|
1136
|
use Perl::Critic::Utils qw{ :severities :ppi :booleans }; |
|
2
|
|
|
|
|
216470
|
|
|
2
|
|
|
|
|
37
|
|
9
|
|
|
|
|
|
|
|
10
|
2
|
|
|
2
|
|
1360
|
use base 'Perl::Critic::Policy'; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
1273
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '0.02'; # VERSION: generated by DZP::OurPkgVersion |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
Readonly::Scalar my $DESC => q{Use of "||" for error handling in open statement}; |
15
|
|
|
|
|
|
|
Readonly::Scalar my $EXPL => q{Use "or" instead of "||", which shortcuts for error handling}; |
16
|
|
|
|
|
|
|
|
17
|
2
|
|
|
2
|
1
|
58
|
sub default_severity { return $SEVERITY_HIGH } |
18
|
0
|
|
|
0
|
1
|
0
|
sub default_themes { return qw< bugs > } |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub applies_to { |
21
|
10
|
|
|
10
|
1
|
1299039
|
return qw< |
22
|
|
|
|
|
|
|
PPI::Token::Word |
23
|
|
|
|
|
|
|
>; |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub violates { |
27
|
30
|
|
|
30
|
1
|
1030
|
my ( $self, $elem, $doc ) = @_; |
28
|
|
|
|
|
|
|
|
29
|
30
|
100
|
|
|
|
95
|
return if $elem->content() ne 'open'; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# We discovered a parenthesis, so we are ok |
32
|
10
|
100
|
|
|
|
110
|
return if $self->_uses_parenthesis($elem); |
33
|
|
|
|
|
|
|
|
34
|
4
|
100
|
|
|
|
21
|
if ($self->_is_high_precedence_logical_operator($elem->snext_sibling())) { |
35
|
2
|
|
|
|
|
15
|
return $self->violation( $DESC, $EXPL, $elem ); |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
2
|
|
|
|
|
8
|
return; # ok! |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub _uses_parenthesis { |
42
|
10
|
|
|
10
|
|
34
|
my ( $self, $elem ) = @_; |
43
|
|
|
|
|
|
|
|
44
|
10
|
100
|
|
|
|
58
|
if ($elem->snext_sibling()->content() =~ m/^[\s]*[(]/xism) { |
45
|
6
|
|
|
|
|
518
|
return $TRUE; |
46
|
|
|
|
|
|
|
} else { |
47
|
4
|
|
|
|
|
182
|
return $FALSE; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub _is_high_precedence_logical_operator { |
52
|
32
|
|
|
32
|
|
743
|
my ( $self, $sibling ) = @_; |
53
|
|
|
|
|
|
|
|
54
|
32
|
100
|
|
|
|
96
|
if ($sibling) { |
55
|
30
|
100
|
|
|
|
125
|
if ($sibling->class eq 'PPI::Token::Operator') { |
56
|
10
|
100
|
|
|
|
51
|
if ($sibling->content eq q{||}) { |
57
|
2
|
|
|
|
|
19
|
return $TRUE; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
} |
60
|
28
|
|
|
|
|
155
|
return $self->_is_high_precedence_logical_operator($sibling->snext_sibling()); |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
2
|
|
|
|
|
14
|
return $FALSE; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
1; |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
__END__ |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=pod |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=encoding UTF-8 |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=begin stopwords |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
autodie TODO Readonly jonasbn ACKNOWLEDGEMENTS DAVECROSS Brømsø |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=end stopwords |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=head1 NAME |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
Perl::Critic::Policy::InputOutput::ProhibitHighPrecedentLogicalOperatorErrorHandling - prohibits logical error handling in open statements |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head1 VERSION |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
This documentation describes version: 0.02 |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=head1 AFFILIATION |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
This policy has no affiliation |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=head1 DESCRIPTION |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
This policy addresses an anti-pattern and possible bug. If you use C<open> combined with the high precedence logical or operator C<||> for error handling. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
If the file parameter is pointing to a non-existent file, the use of a high precedence logical operator C<||>, does not short-cut as expected. This implies that the bug only is present if the file does not exist. If the file exists, but cannot be opened the error handling is not working as expected. |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
open my $fh, '<', $file |
99
|
|
|
|
|
|
|
|| die "Can't open '$file': $!"; # not okay |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
open(my $fh, '<', $file) |
102
|
|
|
|
|
|
|
|| die "Can't open '$file': $!"; # okay |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
open my $fh, '<', $file |
105
|
|
|
|
|
|
|
or die "Can't open '$file': $!"; # okay |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
open my $fh, "<$file" |
108
|
|
|
|
|
|
|
|| die "Can't open '$file': $!"; # not okay |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
open(my $fh, "<$file") |
111
|
|
|
|
|
|
|
|| die "Can't open '$file': $!"; # okay |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
open my $fh, "<$file" |
114
|
|
|
|
|
|
|
or die "Can't open '$file': $!"; # okay |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
The remedy is to use parentheses for C<open> or the lower precedence logical operator C<or>. |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
Alternatively L<autodie|https://metacpan.org/pod/autodie> can be used, |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=head1 CONFIGURATION AND ENVIRONMENT |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
This policy is not configurable at this time. Please see the TODO L</section>. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head1 INCOMPATIBILITIES |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
Do note that this policy conflicts with the policy: |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=over |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=item * L<Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins|https://metacpan.org/pod/Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins> |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=back |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
This distribution holds no known limitations or bugs at this time, please refer to the L<the issue listing on GitHub|https://github.com/jonasbn/perl-critic-policy-regularexpressions-requiredefault/issues> for more up to date information. |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=head1 BUG REPORTING |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
Please report bugs via L<GitHub|https://github.com/jonasbn/perl-critic-policy-regularexpressions-requiredefault/issues>. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=head1 TEST AND QUALITY |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
This distribution aims to adhere to the Perl::Critic::Policy standards and Perl best practices and recommendations. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=head1 DEPENDENCIES AND REQUIREMENTS |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
This distribution requires: |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=over |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=item * Perl 5.6.0 syntactically for the actual implementation |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=item * L<Perl 5.14|https://metacpan.org/pod/release/JESSE/perl-5.14.0/pod/perl.pod> for developing the distribution, which relies on L<Dist::Zilla|http://dzil.org/>. The features on which this policy relies, where introduced in Perl 5.14, but this does not make for an actual requirement for the policy only the recommendations it imposes. |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=item * L<Carp|https://metacpan.org/pod/Carp>, in core since Perl 5. |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=item * L<Readonly|https://metacpan.org/pod/Readonly> |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=item * L<Perl::Critic::Policy|https://metacpan.org/pod/Perl::Critic::Policy> |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=item * L<Perl::Critic::Utils|https://metacpan.org/pod/Perl::Critic::Utils> |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=back |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
Please see the listing in the file: F<cpanfile>, included with the distribution for a complete listing and description for configuration, test and development. |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=head1 TODO |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
Ideas and suggestions for improvements and new features are listed in GitHub and are marked as C<enhancement>. |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=over |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=item * Please see L<the issue listing on GitHub|https://github.com/jonasbn/perl-critic-policy-regularexpressions-requiredefault/issues> |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=back |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=head1 SEE ALSO |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=over |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=item * L<Blog post on Perl Hacks: A Subtle Bug|https://perlhacks.com/2019/01/a-subtle-bug/> by Dave Cross L<@davorg|https://twitter.com/davorg> |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=item * L<Same Blog post on Medium: A Subtle Bug|https://culturedperl.com/a-subtle-bug-c9982f681cb8> by Dave Cross L<@davorg|https://twitter.com/davorg> |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=item * L<Perl::Critic|https://metacpan.org/pod/Perl::Critic> |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=back |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=head1 MOTIVATION |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
The motivation for this Perl::Critic policy came from a L<Blog post on Perl Hacks: A Subtle Bug|https://perlhacks.com/2019/01/a-subtle-bug/> by Dave Cross L<@davorg|https://twitter.com/davorg> |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
In the blog post Dave demonstrates a very subtle bug, which I think many Perl programmers have been or could be bitten by. But instead of searching through the code as a one time activity, I think this would do better as a Perl::Critic policy, so if the bug a some point was reintroduced in the code base it would be caught by Perl::Critic, if you use Perl::Critic that is - and you do use Perl::Critic right? |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=head1 AUTHOR |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=over |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=item * Jonas Brømsø (jonasbn) <jonasbn@cpan.org> |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=back |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=over |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=item * L<Dave Cross (@davorg)|https://twitter.com/davorg> / L<DAVECROSS|https://metacpan.org/author/DAVECROSS> for the blog post sparking the idea for this policy, see link to blog post under L</MOTIVATION> or L</REFERENCES> |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=item * L<Nathan Mills|https://github.com/Quipyowert2> for contributing to this policy, documenting and testing two-argument C<open> |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=back |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
Perl::Critic::Policy::InputOutput::ProhibitHighPrecedentLogicalOperatorErrorHandling is (C) by jonasbn 2019-2021 |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
Perl::Critic::Policy::InputOutput::ProhibitHighPrecedentLogicalOperatorErrorHandling is released under the Artistic License 2.0 |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
Please see the LICENSE file included with the distribution of this module |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=cut |