File Coverage

blib/lib/Perl/Critic/Policy/InputOutput/ProhibitHighPrecedentLogicalOperatorErrorHandling.pm
Criterion Covered Total %
statement 36 37 97.3
branch 14 14 100.0
condition n/a
subroutine 11 12 91.6
pod 4 4 100.0
total 65 67 97.0


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