File Coverage

blib/lib/Perl/Critic/Policy/Lax/ProhibitStringyEval/ExceptForRequire.pm
Criterion Covered Total %
statement 36 37 97.3
branch 18 26 69.2
condition 13 18 72.2
subroutine 8 9 88.8
pod 4 4 100.0
total 79 94 84.0


line stmt bran cond sub pod time code
1 7     7   3476 use strict;
  7         9  
  7         157  
2 7     7   21 use warnings;
  7         7  
  7         288  
3             package Perl::Critic::Policy::Lax::ProhibitStringyEval::ExceptForRequire;
4             # ABSTRACT: stringy eval is bad, but it's okay just to "require"
5             $Perl::Critic::Policy::Lax::ProhibitStringyEval::ExceptForRequire::VERSION = '0.012';
6             #pod =head1 DESCRIPTION
7             #pod
8             #pod Sure, everybody sane agrees that stringy C<eval> is usually a bad thing, but
9             #pod sometimes you need it, and you don't want to have to stick a C<no critic> on
10             #pod the end, because dangit, what you are doing is I<just not wrong>!
11             #pod
12             #pod See, C<require> is busted. You can't pass it a variable containing the name of
13             #pod a module and have it look through C<@INC>. That has lead to this common idiom:
14             #pod
15             #pod eval qq{ require $module } or die $@;
16             #pod
17             #pod This policy acts just like BuiltinFunctions::ProhibitStringyEval, but makes an
18             #pod exception when the content of the string is PPI-parseable Perl that looks
19             #pod something like this:
20             #pod
21             #pod require $module
22             #pod require $module[2];
23             #pod use $module (); 1;
24             #pod
25             #pod Then again, maybe you should use L<Module::Runtime>.
26             #pod
27             #pod =cut
28              
29 7     7   24 use Perl::Critic::Utils;
  7         6  
  7         78  
30 7     7   3270 use parent qw(Perl::Critic::Policy);
  7         8  
  7         28  
31              
32             my $DESCRIPTION = 'Expression form of "eval" for something other than require';
33             my $EXPLANATION = <<'END_EXPLANATION';
34             It's okay to use stringy eval to require a module by name, but otherwise it's
35             probably a mistake.
36             END_EXPLANATION
37              
38 4     4 1 26 sub default_severity { return $SEVERITY_HIGHEST }
39 0     0 1 0 sub default_themes { return qw( danger ) }
40 7     7 1 31008 sub applies_to { return 'PPI::Token::Word' }
41              
42             sub _arg_is_ok {
43 7     7   7 my ($self, $arg) = @_;
44              
45 7 100 100     30 return unless $arg->isa('PPI::Token::Quote::Double')
46             or $arg->isa('PPI::Token::Quote::Interpolate');
47              
48 6         17 my $string = $arg->string;
49              
50 6 50       39 return unless my $doc = eval { PPI::Document->new(\$string) };
  6         15  
51              
52 6         3673 my @children = $doc->schildren;
53              
54             # We only allow {require} and {require;number}
55 6 50       49 return if @children > 2;
56 6 100 100     33 return unless defined $children[0]
57             && $children[0]->isa('PPI::Statement::Include');
58              
59             # We could give up if the Include's second child isn't a Symbol, but... eh!
60              
61             # So, we know it's got a require first. If that's all, great.
62 4 100       10 return 1 if @children == 1;
63              
64             # Otherwise, it must end in something like {1} or {1;}
65 3 50       8 return unless $children[1]->isa('PPI::Statement');
66              
67 3         8 my @tail_bits = $children[1]->schildren;
68              
69 3 100 66     37 return if @tail_bits > 2
      66        
      66        
70             or ! $tail_bits[0]->isa('PPI::Token::Number')
71             or ($tail_bits[1] && $tail_bits[1] ne ';');
72              
73 2         18 return 1;
74             }
75              
76             sub violates {
77 7     7 1 92 my ($self, $elem) = @_;
78              
79 7 50       18 return if $elem ne 'eval';
80 7 50       99 return unless is_function_call($elem);
81              
82 7         1124 my $sib = $elem->snext_sibling();
83 7 50       81 return unless $sib;
84 7 50       23 my $arg = $sib->isa('PPI::Structure::List') ? $sib->schild(0) : $sib;
85              
86             # Blocks are always just fine!
87 7 50 33     42 return if not($arg) or $arg->isa('PPI::Structure::Block');
88              
89             # It's OK if the string we're evaluating is just "require $var"
90 7 100       14 return if $self->_arg_is_ok($arg);
91              
92             # Otherwise, you are in trouble.
93 4         105 return $self->violation($DESCRIPTION, $EXPLANATION, $elem);
94             }
95              
96             1;
97              
98             __END__
99              
100             =pod
101              
102             =encoding UTF-8
103              
104             =head1 NAME
105              
106             Perl::Critic::Policy::Lax::ProhibitStringyEval::ExceptForRequire - stringy eval is bad, but it's okay just to "require"
107              
108             =head1 VERSION
109              
110             version 0.012
111              
112             =head1 DESCRIPTION
113              
114             Sure, everybody sane agrees that stringy C<eval> is usually a bad thing, but
115             sometimes you need it, and you don't want to have to stick a C<no critic> on
116             the end, because dangit, what you are doing is I<just not wrong>!
117              
118             See, C<require> is busted. You can't pass it a variable containing the name of
119             a module and have it look through C<@INC>. That has lead to this common idiom:
120              
121             eval qq{ require $module } or die $@;
122              
123             This policy acts just like BuiltinFunctions::ProhibitStringyEval, but makes an
124             exception when the content of the string is PPI-parseable Perl that looks
125             something like this:
126              
127             require $module
128             require $module[2];
129             use $module (); 1;
130              
131             Then again, maybe you should use L<Module::Runtime>.
132              
133             =head1 AUTHOR
134              
135             Ricardo Signes <rjbs@cpan.org>
136              
137             =head1 COPYRIGHT AND LICENSE
138              
139             This software is copyright (c) 2016 by Ricardo Signes <rjbs@cpan.org>.
140              
141             This is free software; you can redistribute it and/or modify it under
142             the same terms as the Perl 5 programming language system itself.
143              
144             =cut