File Coverage

blib/lib/Perl/Critic/Policy/TryTiny/RequireUse.pm
Criterion Covered Total %
statement 35 37 94.5
branch 8 12 66.6
condition 12 21 57.1
subroutine 12 13 92.3
pod 4 5 80.0
total 71 88 80.6


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::TryTiny::RequireUse;
2 1     1   374031 use 5.008001;
  1         5  
3 1     1   6 use strict;
  1         2  
  1         33  
4 1     1   7 use warnings;
  1         3  
  1         41  
5             our $VERSION = '0.05';
6              
7 1     1   6 use Readonly;
  1         2  
  1         51  
8 1     1   7 use Perl::Critic::Utils qw{ :severities :classification :ppi };
  1         2  
  1         72  
9              
10 1     1   457 use base 'Perl::Critic::Policy';
  1         2  
  1         548  
11              
12             Readonly::Scalar my $DESC => q{Missing "use Try::Tiny"};
13             Readonly::Scalar my $EXPL => q{Try::Tiny blocks will execute even if the try/catch/finally functions have not been imported};
14              
15 5     5 0 1472114 sub supported_parameters { return() }
16 2     2 1 39 sub default_severity { return $SEVERITY_HIGHEST }
17 0     0 1 0 sub default_themes { return qw( bugs ) }
18 5     5 1 537443 sub applies_to { return 'PPI::Token::Word' }
19              
20             sub violates {
21 26     26 1 989 my ($self, $try, $doc) = @_;
22              
23             return
24 26 50 66     70 unless $try->content() eq 'try'
      66        
25             and $try->snext_sibling()
26             and $try->snext_sibling->isa('PPI::Structure::Block');
27              
28 3         214 my $try_package = _find_package( $try );
29              
30             my $included = $doc->find_any(sub{
31 63 50 66 63   1115 $_[1]->isa('PPI::Statement::Include')
      33        
      66        
      33        
32             and
33             defined( $_[1]->module() )
34             and (
35             $_[1]->module() eq 'Error'
36             or
37             $_[1]->module() eq 'Syntax::Feature::Try'
38             or
39             $_[1]->module() eq 'Try'
40             or
41             $_[1]->module() eq 'Try::Catch'
42             or
43             $_[1]->module() eq 'Try::Tiny'
44             or
45             $_[1]->module() eq 'TryCatch'
46             ) and
47             $_[1]->type() eq 'use'
48             and
49             _find_package( $_[1] ) eq $try_package
50 3         119 });
51              
52 3 100       93 return if $included;
53              
54 2         16 return $self->violation( $DESC, $EXPL, $try );
55             }
56              
57             sub _find_package {
58 5     5   363 my ($element) = @_;
59              
60 5         15 my $original = $element;
61              
62 5         21 while ($element) {
63 14 100       304 if ($element->isa('PPI::Statement::Package')) {
64             # If this package statements is a block package, meaning: package { # stuff in package }
65             # then if we're a descendant of it its our package.
66 5 50       25 return $element->namespace() if $element->ancestor_of( $original );
67              
68             # If we've hit a non-block package then thats our package.
69 5         103 my $blocks = $element->find_any('PPI::Structure::Block');
70 5 50       1572 return $element->namespace() if !$blocks;
71             }
72              
73             # Keep walking backwards until we match the above logic or we get to
74             # the document root (main).
75 9   66     38 $element = $element->sprevious_sibling() || $element->parent();
76             }
77              
78 0           return 'main';
79             }
80              
81             1;
82             __END__
83              
84             =head1 NAME
85              
86             Perl::Critic::Policy::TryTiny::RequireUse - Requires that code which utilizes
87             Try::Tiny actually use()es it.
88              
89             =head1 DESCRIPTION
90              
91             A common problem with L<Try::Tiny> is forgetting to use the module in the first
92             place. For example:
93              
94             perl -e 'try { print "hello" } catch { print "world" }'
95             Can't call method "catch" without a package or object reference at -e line 1.
96             helloworld
97              
98             If you forget this then both code blocks will be run and an exception will be thrown.
99             While this seems like a rare issue, when I first implemented this policy I found
100             several cases of this issue in real live code and due to layers of exception handling
101             it had gotten lost and nobody realized that there was a bug happening due to the missing
102             use statements.
103              
104             This policy is OK if you use L<Error>, L<Syntax::Feature::Try>, L<Try>, L<Try::Catch>,
105             and L<TryCatch> modules which also export the C<try> function.
106              
107             =head1 SEE ALSO
108              
109             =over
110              
111             =item *
112              
113             The L<Perl::Critic::Policy::Dynamic::NoIndirect> policy provides a more generic
114             solution to this problem (as the author has reported to me). Consider it as an
115             alternative to this policy.
116              
117             =back
118              
119             =head1 AUTHORS
120              
121             Aran Clary Deltac <bluefeet@gmail.com>
122             Graham TerMarsch <graham@howlingfrog.com>
123              
124             =head1 ACKNOWLEDGEMENTS
125              
126             Thanks to L<ZipRecruiter|https://www.ziprecruiter.com/>
127             for encouraging their employees to contribute back to the open
128             source ecosystem. Without their dedication to quality software
129             development this distribution would not exist.
130              
131             =head1 LICENSE
132              
133             This library is free software; you can redistribute it and/or modify
134             it under the same terms as Perl itself.
135              
136             =cut
137