File Coverage

blib/lib/Perl/Critic/Policy/Variables/ProhibitUnusedVarsStricter.pm
Criterion Covered Total %
statement 347 380 91.3
branch 201 272 73.9
condition 46 62 74.1
subroutine 42 44 95.4
pod 4 5 80.0
total 640 763 83.8


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::Variables::ProhibitUnusedVarsStricter;
2              
3 2     2   453106 use 5.006001;
  2         14  
4 2     2   10 use strict;
  2         5  
  2         46  
5 2     2   12 use warnings;
  2         4  
  2         51  
6              
7 2     2   10 use English qw{ -no_match_vars };
  2         4  
  2         12  
8              
9 2     2   1743 use PPIx::QuoteLike 0.011;
  2         301256  
  2         84  
10 2         112 use PPIx::QuoteLike::Constant 0.011 qw{
11             LOCATION_LINE
12             LOCATION_LOGICAL_LINE
13             LOCATION_CHARACTER
14 2     2   16 };
  2         30  
15 2     2   12 use PPIx::Regexp 0.071;
  2         37  
  2         41  
16 2     2   11 use Readonly;
  2         5  
  2         86  
17 2     2   12 use Scalar::Util qw{ refaddr };
  2         4  
  2         69  
18              
19 2     2   15 use Perl::Critic::Exception::Fatal::PolicyDefinition;
  2         5  
  2         71  
20 2     2   12 use Perl::Critic::Utils qw< :booleans :characters hashify :severities >;
  2         5  
  2         121  
21              
22 2     2   601 use base 'Perl::Critic::Policy';
  2         5  
  2         1116  
23              
24             our $VERSION = '0.112';
25              
26             #-----------------------------------------------------------------------------
27              
28             Readonly::Scalar my $EXPL =>
29             q<Unused variables clutter code and make it harder to read>;
30              
31             # Determine whether a PPI::Statement::Variable refers to a global or a
32             # lexical variable. We need to track globals to avoid false negatives
33             # from things like
34             #
35             # my $foo;
36             # {
37             # our $foo;
38             # $foo = 'bar';
39             # }
40             #
41             # but we do not need to track 'local', because if you
42             # s/ \b our \b /local/smxg
43             # in the above, Perl complains that you can not localize a lexical
44             # variable, rather than localizing the corresponding global variable.
45             Readonly::Hash my %GLOBAL_DECLARATION => (
46             my => $FALSE,
47             state => $FALSE,
48             our => $TRUE,
49             );
50              
51             Readonly::Scalar my $CATCH => 'catch';
52              
53             Readonly::Scalar my $PACKAGE => '_' . __PACKAGE__;
54              
55             Readonly::Scalar my $LEFT_BRACE => q<{>; # } Seems P::C::U should have
56              
57             Readonly::Hash my %IS_COMMA => hashify( $COMMA, $FATCOMMA );
58             Readonly::Hash my %LOW_PRECEDENCE_BOOLEAN => hashify( qw{ and or xor } );
59              
60             Readonly::Array my @DOUBLE_QUOTISH => qw{
61             PPI::Token::Quote::Double
62             PPI::Token::Quote::Interpolate
63             PPI::Token::QuoteLike::Backtick
64             PPI::Token::QuoteLike::Command
65             PPI::Token::QuoteLike::Readline
66             PPI::Token::HereDoc
67             };
68             Readonly::Array my @REGEXP_ISH => qw{
69             PPI::Token::Regexp::Match
70             PPI::Token::Regexp::Substitute
71             PPI::Token::QuoteLike::Regexp
72             };
73              
74             #-----------------------------------------------------------------------------
75              
76             sub supported_parameters { return (
77             {
78 56     56 0 248996 name => 'allow_if_computed_by',
79             description => 'Allow if computed by one of these',
80             behavior => 'string list',
81             },
82             { name => 'prohibit_reference_only_variables',
83             description => 'Prohibit reference-only variables',
84             behavior => 'boolean',
85             default_string => '0',
86             },
87             { name => 'prohibit_returned_lexicals',
88             description => 'Prohibit returned lexicals',
89             behavior => 'boolean',
90             default_string => '0',
91             },
92             { name => 'allow_unused_subroutine_arguments',
93             description => 'Allow unused subroutine arguments',
94             behavior => 'boolean',
95             default_string => '0',
96             },
97             {
98             name => 'allow_state_in_expression',
99             description => 'Allow state variable with low-precedence Boolean',
100             behavior => 'boolean',
101             default_string => '0',
102             },
103             {
104             name => 'check_catch',
105             description => 'Check the catch() clause of try/catch',
106             behavior => 'boolean',
107             default_string => '0',
108             },
109             {
110             name => 'dump',
111             description => 'UNSUPPORTED: Dump symbol definitions',
112             behavior => 'boolean',
113             default_string => '0',
114             },
115             {
116             name => 'trace',
117             description => 'UNSUPPORTED: Trace variable processing',
118             behavior => 'string list',
119             },
120             ) }
121              
122 40     40 1 2412 sub default_severity { return $SEVERITY_MEDIUM }
123 0     0 1 0 sub default_themes { return qw< trw maintenance > }
124 55     55 1 586297 sub applies_to { return qw< PPI::Document > }
125              
126             #-----------------------------------------------------------------------------
127              
128             sub violates {
129             # my ( $self, $elem, $document ) = @_;
130 55     55 1 664 my ( $self, undef, $document ) = @_;
131              
132 55         440 $self->{$PACKAGE} = {
133             declared => {}, # Keyed by PPI::Token::Symbol->symbol().
134             # Values are a list of hashes
135             # representing declarations of the given
136             # symbol, in reverse order. In each
137             # hash:
138             # {declaration} is the PPI statement
139             # object in which the variable is
140             # declared;
141             # {element} is the PPI::Token::Symbol
142             # {is_allowed_computation} is true
143             # if the value of the symbol is
144             # initialized using one of the
145             # allowed subroutines or classes
146             # (e.g. Scope::Guard).
147             # {is_global} is true if the declaration
148             # is a global (i.e. is 'our', not 'my');
149             # {is_state_in_expression} is true if
150             # the variable is a 'state' variable
151             # and the assignment is part of an
152             # expression.
153             # {is_unpacking} is true if the
154             # declaration occurs in an argument
155             # unpacking;
156             # {taking_reference} is true if the code
157             # takes a reference to the declared
158             # variable;
159             # {used} is a count of the number of
160             # times that declaration was used,
161             # initialized to 0.
162              
163             is_declaration => {}, # Keyed by refaddr of PPI::Token::Symbol.
164             # True if the object represents a
165             # declaration.
166              
167             need_sort => $FALSE, # Boolean that says whether the symbol
168             # declarations need to be sorted in
169             # lexical order. Recording a declaration
170             # must set this. Recording a use must
171             # clear this, doing the sort if it was
172             # previously set.
173              
174             ppix_objects => {}, # Cache of PPIx::QuoteLike and
175             # PPIx::Regexp objects indexed by
176             # refaddr of parent element.
177              
178             parent_element => {}, # PPI::Element objects from which
179             # PPI::Document objects have been
180             # derived, indexed by refaddr of derived
181             # document.
182             };
183              
184             # Ensure entire document is indexed. We don't call index_locations()
185             # because that is unconditional. We wrap the whole thing in an eval
186             # because last_token() can fail under undiagnosed circumstances.
187             {
188 55         124 local $EVAL_ERROR = undef;
  55         140  
189 55         134 eval { ## no critic (RequireCheckingReturnValueOfEval)
190 55 50       346 if ( my $token = $document->last_token() ) {
191 55         1997 $token->location();
192             }
193             }
194             }
195              
196 55         929 $self->_get_symbol_declarations( $document );
197              
198 55         254 $self->_get_symbol_uses( $document );
199              
200             $self->{_dump}
201 55 50       176 and $self->_dump();
202              
203 55         176 return $self->_get_violations();
204              
205             }
206              
207             #-----------------------------------------------------------------------------
208              
209             sub _dump {
210 0     0   0 my ( $self ) = @_;
211 0         0 foreach my $name ( sort keys %{ $self->{$PACKAGE}{declared} } ) {
  0         0  
212             # NOTE that 'print { STDERR } ... ' does not compile under
213             # strict refs. '{ *STDERR }' is a terser way to satisfy
214             # InputOutput::RequireBracedFileHandleWithPrint.
215 0         0 print { *STDERR } "$name\n";
  0         0  
216 0         0 foreach my $decl ( @{ $self->{$PACKAGE}{declared}{$name} } ) {
  0         0  
217 0         0 my $sym = $decl->{element};
218 0         0 my $fn = $sym->logical_filename();
219 0 0       0 if ( defined $fn ) {
220 0         0 $fn =~ s/ (?= [\\'] ) /\\/smxg;
221 0         0 $fn = "'$fn'";
222             } else {
223 0         0 $fn = 'undef';
224             }
225 0         0 printf { *STDERR }
226             " %s line %d column %d used %d\n",
227             $fn,
228             $sym->logical_line_number(),
229             $sym->column_number(),
230 0         0 $decl->{used};
231             }
232             }
233 0         0 return;
234             }
235              
236             #-----------------------------------------------------------------------------
237              
238             sub _get_symbol_declarations {
239 55     55   150 my ( $self, $document ) = @_;
240              
241 55         243 $self->_get_variable_declarations( $document );
242              
243 55         253 $self->_get_stray_variable_declarations( $document );
244              
245             $self->{_check_catch}
246 55 100       159 and $self->_get_catch_declarations( $document );
247              
248 55         99 return;
249              
250             }
251              
252             #-----------------------------------------------------------------------------
253              
254             # We assume the argument is actually eligible for this operation.
255             sub _get_ppix_quotelike {
256 58     58   148 my ( $self, $elem ) = @_;
257 58   66     454 return $self->{$PACKAGE}{ppix_objects}{ refaddr $elem } ||=
258             PPIx::QuoteLike->new( $elem );
259             }
260              
261             #-----------------------------------------------------------------------------
262              
263             # We assume the argument is actually eligible for this operation. The
264             # complication here is that if we are dealing with an element of a
265             # Perl::Critic::Document we want to call ppix_regexp_from_element(),
266             # since that caches the returned object, making it available to all
267             # policies. But the ppi() method returns a PPI::Document, so the best we
268             # can do is to cache locally.
269             sub _get_ppix_regexp {
270 18     18   60 my ( $self, $elem ) = @_;
271 18   66     128 return $self->{$PACKAGE}{ppix_objects}{ refaddr $elem } ||= do {
272 9         46 my $doc = $elem->top();
273 9         126 my $code;
274 9 50       97 ( $code = $doc->can( 'ppix_regexp_from_element' ) ) ?
275             $code->( $doc, $elem ) :
276             PPIx::Regexp->new( $elem );
277             };
278             }
279              
280             #-----------------------------------------------------------------------------
281              
282             # Get the PPI::Document that represents a PPIx::* class that supports
283             # one. The arguments are:
284             # $ppix_elem - the PPIx::* element providing the document. This MUST
285             # support the ->ppi() method.
286             # $elem - the original PPI::Element from which this element was
287             # derived.
288             # NOTE that all calls to ->ppi() MUST come through here.
289             sub _get_derived_ppi_document {
290 70     70   173 my ( $self, $ppix_elem, $elem ) = @_;
291 70 50       269 my $ppi = $ppix_elem->ppi()
292             or return;
293 70   66     34758 $self->{$PACKAGE}{parent_element}{ refaddr( $ppi ) } ||= $elem;
294 70         234 return $ppi;
295             }
296              
297             #-----------------------------------------------------------------------------
298              
299             # Get the PPI::Element that is the parent of the given PPI::Element,
300             # taking into account that the given element may be a derived
301             # PPI::Document.
302             # NOTE that all calls to PPI::Element->parent() MUST come through here.
303             sub _get_parent_element {
304 237     237   477 my ( $self, $elem ) = @_;
305 237 100       563 if ( my $parent = $elem->parent() ) {
306 199         1364 return $parent;
307             } else {
308 38         289 return $self->{$PACKAGE}{parent_element}{ refaddr( $elem ) };
309             }
310             }
311              
312             #-----------------------------------------------------------------------------
313              
314             # Get the lowest parent of the inner element that is in the same
315             # document as the outer element.
316             sub _get_lowest_in_same_doc {
317 82     82   152 my ( $self, $inner_elem, $outer_elem ) = @_;
318 82 50       268 my $outer_top = $outer_elem->top()
319             or return;
320 82         893 while ( 1 ) {
321 114 50       258 my $inner_top = $inner_elem->top()
322             or last;
323 114 100       1340 $inner_top == $outer_top
324             and return $inner_elem;
325 36 100       214 $inner_elem = $self->_get_parent_element( $inner_top )
326             or last;
327             }
328 4         18 return;
329             }
330              
331             #-----------------------------------------------------------------------------
332              
333             sub _get_ppi_statement_variable {
334 90     90   215 my ( $self, $document ) = @_;
335              
336 90 100       175 my @rslt = @{ $document->find( 'PPI::Statement::Variable' ) || [] };
  90         256  
337              
338 90         10040 foreach my $class ( @DOUBLE_QUOTISH ) {
339 540 100       46503 foreach my $elem ( @{ $document->find( $class ) || [] } ) {
  540         1218  
340 29 50       883 my $str = $self->_get_ppix_quotelike( $elem )
341             or next;
342 29 100       34629 foreach my $code ( @{ $str->find(
  29         97  
343             'PPIx::QuoteLike::Token::Interpolation' ) || [] } ) {
344 26 50       1791 my $ppi = $self->_get_derived_ppi_document( $code, $elem )
345             or next;
346 26         81 push @rslt, $self->_get_ppi_statement_variable( $ppi );
347             }
348             }
349             }
350              
351 90         8996 foreach my $class ( @REGEXP_ISH ) {
352 270 100       17555 foreach my $elem ( @{ $document->find( $class ) || [] } ) {
  270         661  
353 9 50       767 my $pre = $self->_get_ppix_regexp( $elem )
354             or next;
355 9 50       75548 foreach my $code ( @{ $pre->find(
  9         41  
356             'PPIx::Regexp::Token::Code' ) || [] } ) {
357 9 50       2522 my $ppi = $self->_get_derived_ppi_document( $code, $elem )
358             or next;
359 9         35 push @rslt, $self->_get_ppi_statement_variable( $ppi );
360             }
361             }
362             }
363              
364 90         9050 return @rslt;
365             }
366              
367             #-----------------------------------------------------------------------------
368              
369             # The catch() clause of try/catch is a special case because the 'my' is
370             # implied. Also the syntax requires you to specify a variable even if
371             # you have no intention of using it.
372             # NOTE that we assume that if we get called, the check is to be done.
373             sub _get_catch_declarations {
374 2     2   6 my ( $self, $document ) = @_;
375 2 50       4 foreach my $word ( @{ $document->find( 'PPI::Token::Word' ) || [] } ) {
  2         7  
376 7 100       47 $CATCH eq $word->content()
377             or next;
378 2 50       14 my $list = $word->snext_sibling()
379             or next;
380 2 50       94 $list->isa( 'PPI::Structure::List' )
381             or next;
382 2 50       18 my $block = $list->snext_sibling()
383             or next;
384 2 50       54 $block->isa( 'PPI::Structure::Block' )
385             or next;
386 2 50       5 foreach my $sym ( @{ $list->find( 'PPI::Token::Symbol' ) || [] } ) {
  2         7  
387             # Should be only one, but ...
388 2         564 $self->_record_symbol_definition(
389             $sym, $sym->statement() );
390             }
391             }
392 2         8 return;
393             }
394              
395             #-----------------------------------------------------------------------------
396              
397             # Sorry, but this is just basicly hard.
398             sub _get_variable_declarations { ## no critic (ProhibitExcessComplexity)
399 55     55   181 my ( $self, $document ) = @_;
400              
401 55         191 foreach my $declaration ( $self->_get_ppi_statement_variable( $document ) ) {
402              
403             # This _should_ be the initial 'my', 'our' 'state'
404 98 50       1226 my $elem = $declaration->schild( 0 )
405             or next;
406              
407 98         1349 my $is_unpacking = $declaration->content() =~ m<
408             = \s* (?: \@_ |
409             shift (?: \s* \@_ )? ) |
410             \$_ [[] .*? []]
411             \s* ;? \z >smx;
412              
413 98         4127 my $taking_reference = $self->_taking_reference_of_variable(
414             $declaration );
415              
416 98         565 my $returned_lexical = $self->_returned_lexical( $declaration );
417              
418 98         942 while ( 1 ) {
419              
420             # Looking for 'my', 'our', or 'state'
421 277 100       4491 $elem->isa( 'PPI::Token::Word' )
422             or next;
423             defined( my $is_global = $GLOBAL_DECLARATION{
424 116 100       321 $elem->content()} )
425             or next;
426              
427 100 100       1367 $elem = $elem->snext_sibling()
428             or last;
429              
430             # We can't just look for symbols, since PPI parses the
431             # parens in
432             # open( my $fh, '>&', \*STDOUT )
433             # as a PPI::Statement::Variable, and we get a false positive
434             # on STDOUT.
435 98         2286 my @symbol_list;
436 98 100       309 if ( $elem->isa( 'PPI::Token::Symbol' ) ) {
    50          
437 89         188 push @symbol_list, $elem;
438             } elsif ( $elem->isa( 'PPI::Structure::List' ) ) {
439             push @symbol_list, @{
440 9 50       103 $elem->find( 'PPI::Token::Symbol' ) || [] };
  9         27  
441             } else {
442 0         0 next;
443             }
444              
445 98         2738 my ( $assign, $is_allowed_computation,
446             $is_state_in_expression );
447              
448 98         259 while ( $elem = $elem->snext_sibling() ) {
449 103 100       2226 $elem->isa( 'PPI::Token::Operator' )
450             or next;
451 85         205 my $content = $elem->content();
452 85 100       507 $IS_COMMA{$content}
453             and last;
454 82 100       627 if ( $EQUAL eq $content ) {
455 80         130 $assign = $elem;
456              
457 80         216 $is_allowed_computation = $self->_is_allowed_computation(
458             $assign );
459              
460 80         223 $is_state_in_expression = $self->_is_state_in_expression(
461             $declaration, $assign );
462              
463 80         2832 last;
464             }
465             }
466              
467 98         570 foreach my $symbol ( @symbol_list ) {
468              
469 105 100       271 if ( $assign ) {
470 84 50 33     232 $symbol->logical_line_number() <
      33        
471             $assign->logical_line_number()
472             or $symbol->logical_line_number() ==
473             $assign->logical_line_number()
474             and $symbol->column_number() < $assign->column_number()
475             or next;
476             }
477              
478             $self->_record_symbol_definition(
479 105         5510 $symbol, $declaration,
480             is_allowed_computation => $is_allowed_computation,
481             is_global => $is_global,
482             is_state_in_expression => $is_state_in_expression,
483             is_unpacking => $is_unpacking,
484             taking_reference => $taking_reference,
485             returned_lexical => $returned_lexical,
486             );
487              
488             }
489              
490             } continue {
491 275 100 100     1222 $elem
492             and $elem = $elem->snext_sibling()
493             or last;
494             }
495              
496             }
497              
498 55         1012 return;
499             }
500              
501             #-----------------------------------------------------------------------------
502              
503             {
504              
505             Readonly::Hash my %IS_FOR => hashify( qw{ for foreach } );
506             Readonly::Hash my %IS_RETURN => hashify( qw{ return } );
507              
508             # Get stray declarations that do not show up in
509             # PPI::Statement::Variable statements. These show up in
510             # PPI::Statement::Compound (specifically 'for' and 'foreach'), and
511             # in PPI::Statement::Break (specifically 'return'). In the case of
512             # 'return', we do not need to descend into paren, because if there
513             # are parens, PPI produces a PPI::Statement::Variable.
514              
515             sub _get_stray_variable_declarations {
516 55     55   140 my ( $self, $document ) = @_;
517              
518 55         404 foreach (
519             [ 'PPI::Statement::Compound' => {
520             want => \%IS_FOR,
521             returned_lexical => $FALSE,
522             } ],
523             [ 'PPI::Statement::Break' => {
524             want => \%IS_RETURN,
525             returned_lexical => $TRUE,
526             } ],
527             ) {
528 110         795 my ( $class, $info ) = @{ $_ };
  110         233  
529 110         199 foreach my $declaration (
530 110 100       369 @{ $document->find( $class ) || [] }
531             ) {
532              
533 21 50       226 my $type = $declaration->schild( 0 )
534             or next;
535              
536 21         289 my $type_str = $type->content();
537              
538 21 100       866 if ( $info->{want}{$type_str} ) {
539              
540 9 50       67 my $sib = $type->snext_sibling()
541             or next;
542              
543             # We're looking for 'my', 'state', or 'our'.
544 9 100       197 $sib->isa( 'PPI::Token::Word' )
545             or next;
546 6         15 my $sib_content = $sib->content();
547 6 50       40 defined( my $is_global = $GLOBAL_DECLARATION{$sib_content} )
548             or next;
549              
550 6 50       59 my $symbol = $sib->snext_sibling()
551             or next;
552 6 50       127 $symbol->isa( 'PPI::Token::Symbol' )
553             or next;
554              
555             $self->_record_symbol_definition(
556             $symbol, $declaration,
557             is_global => $is_global,
558             returned_lexical => $info->{returned_lexical},
559 6         20 );
560              
561             }
562              
563             }
564              
565             }
566              
567 55         623 return;
568             }
569              
570             }
571              
572             #-----------------------------------------------------------------------------
573              
574             sub _is_allowed_computation {
575 80     80   206 my ( $self, $elem ) = @_; # $elem presumed to be '='.
576              
577 80 50       203 my $next_sib = $elem->snext_sibling() or return;
578              
579 80 100       1957 if ( $next_sib->isa( 'PPI::Token::Word' ) ) {
    100          
580              
581             # We are presumed to be a subroutine call.
582 12         32 my $content = $next_sib->content();
583 12 100       68 $self->{_allow_if_computed_by}{$content}
584             and return $content;
585              
586             } elsif ( $next_sib->isa( 'PPI::Token::Symbol' ) ) {
587              
588             # We might be a method call.
589 8 50       20 $next_sib = $next_sib->snext_sibling()
590             or return;
591 8 50 33     185 $next_sib->isa( 'PPI::Token::Operator' )
592             and q{->} eq $next_sib->content()
593             or return;
594 0 0       0 $next_sib = $next_sib->snext_sibling()
595             or return;
596 0         0 my $content = $next_sib->content();
597 0 0       0 $self->{_allow_if_computed_by}{$content}
598             and return $content;
599             }
600              
601 71         202 return;
602             }
603              
604             #-----------------------------------------------------------------------------
605              
606             # Find cases where the value of a state variable is used by the
607             # statement that declares it, or an expression in which that statement
608             # appears. The user may wish to accept such variables even if the
609             # variable itself appears only in the statement that declares it.
610             #
611             # $declaration is assumed to be a PPI::Statement::Variable. We return
612             # $FALSE unless it declares state variables.
613             #
614             # $operator is the first assignment operator in $declaration.
615             #
616             # NOTE that this will never be called for stuff like
617             # $foo and state $bar = 42
618             # because PPI does not parse this as a PPI::Statement::Variable.
619             sub _is_state_in_expression {
620 80     80   174 my ( $self, $declaration, $operator ) = @_;
621              
622             # We're only interested in state declarations.
623 80 100       265 q<state> eq $declaration->type()
624             or return $FALSE;
625              
626             # We accept things like
627             # state $foo = bar() and ...
628 5         202 my $next_sib = $operator;
629 5         16 while ( $next_sib = $next_sib->snext_sibling() ) {
630             $next_sib->isa( 'PPI::Token::Operator' )
631 12 100 66     291 and $LOW_PRECEDENCE_BOOLEAN{ $next_sib->content() }
632             and return $TRUE;
633             }
634              
635             # We accept things like
636             # ... ( state $foo = bar() ) ...
637             # IF at least one of the ellipses has an operator adjacent to our
638             # declaration.
639 3         73 my $elem = $declaration;
640 3         11 while ( $elem ) {
641 6         14 foreach my $method ( qw{ snext_sibling sprevious_sibling } ) {
642 11 100       65 my $sib = $elem->$method()
643             or next;
644 3 100       61 $sib->isa( 'PPI::Token::Operator' )
645             and return $TRUE;
646             }
647 5         88 $elem = $self->_get_parent_element( $elem );
648             }
649              
650             # There are no other known cases where a state variable's value can
651             # be used without the variable name appearing anywhere other than
652             # its initialization.
653 2         5 return $FALSE;
654             }
655              
656             #-----------------------------------------------------------------------------
657              
658             sub _taking_reference_of_variable {
659 98     98   284 my ( $self, $elem ) = @_; # Expect a PPI::Statement::Variable
660 98 50       283 my $parent = $self->_get_parent_element( $elem )
661             or return;
662 98         173 my $cast;
663              
664 98 100       600 if ( $parent->isa( 'PPI::Structure::List' ) ) {
    100          
665              
666 10 100       84 $cast = $parent->sprevious_sibling()
667             or return;
668              
669             } elsif ( $parent->isa( 'PPI::Structure::Block' ) ) {
670              
671 23 100       80 my $prev = $parent->sprevious_sibling()
672             or return;
673              
674 14 100       388 $prev->isa( 'PPI::Token::Word' )
675             or return;
676 13 100       39 'do' eq $prev->content()
677             or return;
678              
679 4         30 $cast = $prev->sprevious_sibling()
680              
681             }
682              
683             $cast
684 78 100       542 or return;
685 11 100       51 $cast->isa( 'PPI::Token::Cast' )
686             or return;
687 6         16 return q<\\> eq $cast->content()
688             }
689              
690             #-----------------------------------------------------------------------------
691              
692             sub _returned_lexical {
693 98     98   200 my ( $self, $elem ) = @_; # Expect a PPI::Statement::Variable
694 98 50       197 my $parent = $self->_get_parent_element( $elem )
695             or return;
696 98 100       322 my $stmt = $parent->statement()
697             or return;
698 34 100       660 $stmt->isa( 'PPI::Statement::Break' )
699             or return;
700 2 50       7 my $kind = $stmt->schild( 0 )
701             or return; # Should never happen.
702 2         28 return 'return' eq $kind->content();
703             }
704              
705             #-----------------------------------------------------------------------------
706              
707             {
708              
709             Readonly::Hash my %CAST_FOR_BARE_BRACKETED_VARIABLE => qw{
710             @ @
711             $ $
712             $$ $
713             % %
714             };
715              
716             sub _get_symbol_uses {
717 90     90   233 my ( $self, $document ) = @_;
718              
719 90         178 foreach my $symbol (
720 90 100       271 @{ $document->find( 'PPI::Token::Symbol' ) || [] }
721             ) {
722 197 100       9204 $self->{$PACKAGE}{is_declaration}->{ refaddr( $symbol ) } and next;
723              
724 84         249 $self->_record_symbol_use( $document, $symbol );
725              
726             }
727              
728             # For some reason, PPI parses '$#foo' as a
729             # PPI::Token::ArrayIndex. $#$foo is parsed as a Cast followed
730             # by a Symbol, so as long as nobody decides the '$#' cast causes
731             # $elem->symbol() to return something other than '$foo', we're
732             # cool.
733 90         605 foreach my $elem (
734 90 100       249 @{ $document->find( 'PPI::Token::ArrayIndex' ) || [] }
735             ) {
736              
737 1         13 my $name = $elem->content();
738 1 50       8 $name =~ s/ \A \$ [#] /@/smx or next;
739              
740 1         4 $self->_record_symbol_use( $document, $elem, $name );
741             }
742              
743             # Occasionally you see something like ${foo} outside quotes.
744             # This is legitimate, though PPI parses it as a cast followed by
745             # a block. On the assumption that there are fewer blocks than
746             # words in most Perl, we start at the top and work down. Perl
747             # also handles punctuation variables specified this way, but
748             # since PPI goes berserk when it sees this, we won't bother.
749             #
750             # And EXTREMELY occasionally something like $${foo} gets parsed
751             # as magic followed by subscript.
752 90         8794 foreach my $class ( qw{
753             PPI::Structure::Block
754             PPI::Structure::Subscript
755             }
756             ) {
757 180         8014 foreach my $elem (
758 180 100       473 @{ $document->find( $class ) || [] }
759             ) {
760 59 100       3631 $LEFT_BRACE eq $elem->start() # Only needed for subscript.
761             or next;
762 51 100       849 my $previous = $elem->sprevious_sibling()
763             or next;
764 41 100 66     1099 $previous->isa( 'PPI::Token::Cast' )
765             or $previous->isa( 'PPI::Token::Magic' ) # $${foo}
766             or next;
767             my $sigil = $CAST_FOR_BARE_BRACKETED_VARIABLE{
768 4 50       12 $previous->content() }
769             or next;
770              
771 4         58 my @kids = $elem->schildren();
772 4 50       55 1 == @kids
773             or next;
774 4 50       15 $kids[0]->isa( 'PPI::Statement' )
775             or next;
776              
777 4         16 my @grand_kids = $kids[0]->schildren();
778 4 50       30 1 == @grand_kids
779             or next;
780              
781             # Yes, "${v6}_..." occurred, and was parsed as a
782             # PPI::Token::Number::Version by PPI 1.270.
783 4 100 66     95 $grand_kids[0]->isa( 'PPI::Token::Word' )
784             or $grand_kids[0]->isa( 'PPI::Token::Number::Version' )
785             or next;
786              
787 1         11 $self->_record_symbol_use( $document, $elem,
788             $sigil . $grand_kids[0]->content(),
789             );
790             }
791             }
792              
793 90         5705 $self->_get_regexp_symbol_uses( $document );
794              
795 90         299 $self->_get_double_quotish_string_uses( $document );
796              
797 90         203 return;
798             }
799              
800             }
801              
802             #-----------------------------------------------------------------------------
803              
804             # Record the definition of a symbol.
805             # $symbol is the PPI::Token::Symbol
806             # $declaration is the statement that declares it
807             # %arg is optional arguments, collected and recorded to support the
808             # various configuration items.
809             sub _record_symbol_definition {
810 115     115   691 my ( $self, $symbol, $declaration, %arg ) = @_;
811              
812 115         380 my $ref_addr = refaddr( $symbol );
813 115         369 my $sym_name = $symbol->symbol();
814              
815 115         5209 $self->{$PACKAGE}{is_declaration}{$ref_addr} = 1;
816              
817 115         258 $arg{declaration} = $declaration;
818 115         362 $arg{element} = $symbol;
819 115         269 $arg{used} = 0;
820              
821 115         242 foreach my $key ( qw{
822             is_allowed_computation
823             is_global
824             is_state_in_expression
825             is_unpacking
826             taking_reference
827             returned_lexical
828             } ) {
829             exists $arg{$key}
830 690 100       1458 or $arg{$key} = $FALSE;
831             }
832              
833 115 50       319 if ( $self->{_trace}{$sym_name} ) {
834 0         0 printf { *STDERR }
  0         0  
835             "%s 0x%x declared at line %d col %d\n",
836             $sym_name, $ref_addr,
837             $symbol->logical_line_number(), $symbol->column_number();
838             }
839              
840 115   100     195 push @{ $self->{$PACKAGE}{declared}{ $sym_name } ||= [] }, \%arg;
  115         551  
841              
842 115         267 $self->{$PACKAGE}{need_sort} = $TRUE;
843              
844 115         321 return;
845             }
846              
847             #-----------------------------------------------------------------------------
848              
849             sub _record_symbol_use {
850 86     86   222 my ( $self, undef, $symbol, $symbol_name ) = @_; # $document not used
851              
852 86         156 my $declaration;
853              
854 86 100       287 defined $symbol_name
855             or $symbol_name = $symbol->symbol();
856              
857 86 100       4000 if ( ! ( $declaration = $self->{$PACKAGE}{declared}{$symbol_name} ) ) {
858             # If we did not find a declaration for the symbol, it may
859             # have been declared en passant, as part of doing something
860             # else.
861 19 100       53 my $prev = $symbol->sprevious_sibling()
862             or return;
863 13 100       377 $prev->isa( 'PPI::Token::Word' )
864             or return;
865 5         14 my $content = $prev->content();
866 5 100       36 exists $GLOBAL_DECLARATION{$content}
867             or return;
868              
869             # Yup. It's a declaration. Record it.
870 2         22 $declaration = $symbol->statement();
871              
872 2         33 my $cast = $prev->sprevious_sibling();
873 2 50       40 if ( ! $cast ) {
874 0         0 my $parent;
875 0 0       0 $parent = $self->_get_parent_element( $prev )
876             and $cast = $parent->sprevious_sibling();
877             }
878              
879             $self->_record_symbol_definition(
880             $symbol, $declaration,
881 2         12 is_global => $GLOBAL_DECLARATION{$content},
882             taking_reference => _element_takes_reference( $cast ),
883             );
884              
885 2         6 return;
886             }
887              
888 67 100       200 if ( delete $self->{$PACKAGE}{need_sort} ) {
889             # Because we need multiple passes to find all the declarations,
890             # we have to put them in reverse order when we're done. We need
891             # to repeat the check because of the possibility of picking up
892             # declarations made in passing while trying to find uses.
893             # Re the 'no critic' annotation: I understand that 'reverse ...'
894             # is faster and clearer than 'sort { $b cmp $a } ...', but I
895             # think the dereferenes negate this.
896 30         56 foreach my $decls ( values %{ $self->{$PACKAGE}{declared} } ) {
  30         150  
897 53         149 @{ $decls } = map { $_->[0] }
  67         515  
898             sort { ## no critic (ProhibitReverseSortBlock)
899 14 50       208 $b->[1][LOCATION_LOGICAL_LINE] <=>
900             $a->[1][LOCATION_LOGICAL_LINE] ||
901             $b->[1][LOCATION_CHARACTER] <=>
902             $a->[1][LOCATION_CHARACTER]
903             }
904 67         323 map { [ $_, $_->{element}->location() ] }
905 53         97 @{ $decls };
  53         102  
906             }
907             }
908              
909 67         139 foreach my $decl_scope ( @{ $declaration } ) {
  67         176  
910             $self->_derived_element_is_in_lexical_scope_after_statement_containing(
911             $symbol, $decl_scope->{declaration} )
912 82 100       335 or next;
913 67         1013 $decl_scope->{used}++;
914 67 50       176 if ( $self->{_trace}{$symbol_name} ) {
915 0         0 my $elem = $decl_scope->{element};
916 0         0 printf { *STDERR }
  0         0  
917             "%s at line %d col %d refers to 0x%x at line %d col %d\n",
918             $symbol_name,
919             $symbol->logical_line_number(),
920             $symbol->column_number(),
921             refaddr( $elem ),
922             $elem->logical_line_number(),
923             $elem->column_number(),
924             ;
925             }
926 67         177 return;
927             }
928              
929 0 0       0 if ( $self->{_trace}{$symbol_name} ) {
930 0         0 printf { *STDERR }
  0         0  
931             "Failed to resolve %s at line %d col %d\n",
932             $symbol_name,
933             $symbol->logical_line_number(),
934             $symbol->column_number(),
935             ;
936             }
937              
938 0         0 return;
939              
940             }
941              
942             sub _derived_element_is_in_lexical_scope_after_statement_containing {
943 82     82   200 my ( $self, $inner_elem, $outer_elem ) = @_;
944              
945 82 100       235 my $effective_inner = $self->_get_lowest_in_same_doc( $inner_elem,
946             $outer_elem )
947             or return $FALSE;
948              
949 78         615 return _element_is_in_lexical_scope_after_statement_containing(
950             $effective_inner, $outer_elem );
951              
952             }
953              
954             #-----------------------------------------------------------------------------
955              
956             sub _element_takes_reference {
957 2     2   6 my ( $elem ) = @_;
958 2   33     25 return $elem && $elem->isa( 'PPI::Token::Cast' ) &&
959             $BSLASH eq $elem->content();
960             }
961              
962             #-----------------------------------------------------------------------------
963              
964             sub _get_double_quotish_string_uses {
965 90     90   203 my ( $self, $document ) = @_;
966              
967 90         230 foreach my $class ( @DOUBLE_QUOTISH ) {
968 540         44243 foreach my $double_quotish (
969 540 100       1203 @{ $document->find( $class ) || [] }
970             ) {
971              
972 29 50       716 my $str = $self->_get_ppix_quotelike( $double_quotish )
973             or next;
974              
975 29         49 foreach my $interp ( @{
976 29 100       114 $str->find( 'PPIx::QuoteLike::Token::Interpolation' ) || [] } ) {
977              
978 26 50       984 my $subdoc = $self->_get_derived_ppi_document(
979             $interp, $double_quotish )
980             or next;
981              
982 26         84 $self->_get_symbol_uses( $subdoc, $double_quotish );
983              
984             }
985              
986             }
987             }
988              
989 90         8851 return;
990             }
991              
992             #-----------------------------------------------------------------------------
993              
994             sub _get_regexp_symbol_uses {
995 90     90   200 my ( $self, $document ) = @_;
996              
997 90         330 foreach my $class ( @REGEXP_ISH ) {
998              
999 270 100       17767 foreach my $regex ( @{ $document->find( $class ) || [] } ) {
  270         610  
1000              
1001 9 50       806 my $ppix = $self->_get_ppix_regexp( $regex )
1002             or next;
1003              
1004 9         21 foreach my $code ( @{
1005 9 50       39 $ppix->find( 'PPIx::Regexp::Token::Code' ) || [] } ) {
1006              
1007 9         2674 my $subdoc = $self->_get_derived_ppi_document( $code,
1008             $regex );
1009              
1010 9         30 $self->_get_symbol_uses( $subdoc, $regex );
1011             }
1012              
1013             }
1014              
1015             }
1016              
1017 90         8821 return;
1018             }
1019              
1020             #-----------------------------------------------------------------------------
1021              
1022             sub _get_violations {
1023 55     55   139 my ( $self ) = @_;
1024              
1025 55         111 my @in_violation;
1026              
1027 55         87 foreach my $name ( values %{ $self->{$PACKAGE}{declared} } ) {
  55         219  
1028 92         153 foreach my $declaration ( @{ $name } ) {
  92         181  
1029             $declaration->{is_global}
1030 115 100       240 and next;
1031             $declaration->{used}
1032 114 100       271 and next;
1033             $declaration->{is_allowed_computation}
1034 55 100       125 and next;
1035             $declaration->{is_state_in_expression}
1036             and $self->{_allow_state_in_expression}
1037 54 100 100     125 and next;
1038             $declaration->{taking_reference}
1039             and not $self->{_prohibit_reference_only_variables}
1040 52 100 100     185 and next;
1041             $declaration->{returned_lexical}
1042             and not $self->{_prohibit_returned_lexicals}
1043 48 100 100     132 and next;
1044             $declaration->{is_unpacking}
1045             and $self->{_allow_unused_subroutine_arguments}
1046 46 100 100     106 and next;
1047 40         91 push @in_violation, $declaration->{element};
1048             }
1049             }
1050              
1051 40         3336 return ( map { $self->violation(
1052             sprintf( '%s is declared but not used', $_->symbol() ),
1053             $EXPL,
1054             $_
1055 55 50       245 ) } sort { $a->logical_line_number() <=> $b->logical_line_number() ||
  23         363  
1056             $a->column_number() <=> $b->column_number() }
1057             @in_violation );
1058             }
1059              
1060             #-----------------------------------------------------------------------------
1061              
1062             # THIS CODE HAS ABSOLUTELY NO BUSINESS BEING HERE. It should probably be
1063             # its own module; PPIx::Scope or something like that. The problem is
1064             # that I no longer "own" it, and am having trouble getting modifications
1065             # through. So I have stuck it here for the moment, but I hope it will
1066             # not stay here. Other than here, it appears in Perl::Critic::Document
1067             # (the copy I am trying to get modified) and Perl::ToPerl6::Document (a
1068             # cut-and-paste of an early version.)
1069             #
1070             # THIS CODE IS PRIVATE TO THIS MODULE. The author reserves the right to
1071             # change it or remove it without any notice whatsoever. YOU HAVE BEEN
1072             # WARNED.
1073             #
1074             # This got hung on the Perl::Critic::Document, rather than living in
1075             # Perl::Critic::Utils::PPI, because of the possibility that caching of scope
1076             # objects would turn out to be desirable.
1077              
1078             # sub element_is_in_lexical_scope_after_statement_containing {...}
1079             sub _element_is_in_lexical_scope_after_statement_containing {
1080 78     78   177 my ( $inner_elem, $outer_elem ) = @_;
1081              
1082 78 50       168 $inner_elem->top() == $outer_elem->top()
1083             or Perl::Critic::Exception::Fatal::PolicyDefinition->throw(
1084             message => 'Elements must be in same document' );
1085              
1086             # If the outer element defines a scope, we're true if and only if
1087             # the outer element contains the inner element, and the inner
1088             # element is not somewhere that is hidden from the scope.
1089 78 100       1546 if ( $outer_elem->scope() ) {
1090 6         16 return _inner_element_is_in_outer_scope_really(
1091             $inner_elem, $outer_elem );
1092             }
1093              
1094             # In the more general case:
1095              
1096             # The last element of the statement containing the outer element
1097             # must be before the inner element. If not, we know we're false,
1098             # without walking the parse tree.
1099              
1100 72 50       175 my $stmt = $outer_elem->statement()
1101             or return;
1102              
1103 72         709 my $last_elem = $stmt;
1104 72         210 while ( $last_elem->isa( 'PPI::Node' ) ) {
1105 74 50       206 $last_elem = $last_elem->last_element()
1106             or return;
1107             }
1108              
1109 72 50       557 my $stmt_loc = $last_elem->location()
1110             or return;
1111              
1112 72 50       880 my $inner_loc = $inner_elem->location()
1113             or return;
1114              
1115 72 50       781 $stmt_loc->[LOCATION_LINE] > $inner_loc->[LOCATION_LINE]
1116             and return;
1117 72 100 100     229 $stmt_loc->[LOCATION_LINE] == $inner_loc->[LOCATION_LINE]
1118             and $stmt_loc->[LOCATION_CHARACTER] >= $inner_loc->[LOCATION_CHARACTER]
1119             and return;
1120              
1121             # Since we know the inner element is after the outer element, find
1122             # the element that defines the scope of the statement that contains
1123             # the outer element.
1124              
1125 67         118 my $parent = $stmt;
1126 67         155 while ( ! $parent->scope() ) {
1127             # Things appearing in the right-hand side of a
1128             # PPI::Statement::Variable are not in-scope to its left-hand
1129             # side. RESTRICTION -- this code does not handle truly
1130             # pathological stuff like
1131             # my ( $c, $d ) = qw{ e f };
1132             # my ( $a, $b ) = my ( $c, $d ) = ( $c, $d );
1133 72 50 66     207 _inner_is_defined_by_outer( $inner_elem, $parent )
1134             and _location_is_in_right_hand_side_of_assignment(
1135             $parent, $inner_elem )
1136             and return;
1137 72 50       639 $parent = $parent->parent()
1138             or return;
1139             }
1140              
1141             # We're true if and only if the scope of the outer element contains
1142             # the inner element.
1143              
1144 67         499 return $inner_elem->descendant_of( $parent );
1145              
1146             }
1147              
1148             # Helper for element_is_in_lexical_scope_after_statement_containing().
1149             # Return true if and only if $outer_elem is a statement that defines
1150             # variables and $inner_elem is actually a variable defined in that
1151             # statement.
1152             sub _inner_is_defined_by_outer {
1153 72     72   154 my ( $inner_elem, $outer_elem ) = @_;
1154 72 100 100     450 $outer_elem->isa( 'PPI::Statement::Variable' )
1155             and $inner_elem->isa( 'PPI::Token::Symbol' )
1156             or return;
1157 36         119 my %defines = hashify( $outer_elem->variables() );
1158 36         2205 return $defines{$inner_elem->symbol()};
1159             }
1160              
1161             # Helper for element_is_in_lexical_scope_after_statement_containing().
1162             # Given that the outer element defines a scope, there are still things
1163             # that are lexically inside it but outside the scope. We return true if
1164             # and only if the inner element is inside the outer element, but not
1165             # inside one of the excluded elements. The cases handled so far:
1166             # for ----- the list is not part of the scope
1167             # foreach - the list is not part of the scope
1168              
1169             sub _inner_element_is_in_outer_scope_really {
1170 6     6   11 my ( $inner_elem, $outer_elem ) = @_;
1171 6 50       30 $outer_elem->scope()
1172             or return;
1173 6 50       23 $inner_elem->descendant_of( $outer_elem )
1174             or return;
1175 6 50       97 if ( $outer_elem->isa( 'PPI::Statement::Compound' ) ) {
1176 6 50       16 my $first = $outer_elem->schild( 0 )
1177             or return;
1178 6 50       85 if ( { for => 1, foreach => 1 }->{ $first->content() } ) {
1179 6         26 my $next = $first;
1180 6         13 while ( $next = $next->snext_sibling() ) {
1181 18 100       388 $next->isa( 'PPI::Structure::List' )
1182             or next;
1183 6         42 return ! $inner_elem->descendant_of( $next );
1184             }
1185             }
1186             }
1187 0         0 return $TRUE;
1188             }
1189              
1190             # Helper for element_is_in_lexical_scope_after_statement_containing().
1191             # Given and element that represents an assignment or assignment-ish
1192             # statement, and a location, return true if the location is to the right
1193             # of the equals sign, and false otherwise (including the case where
1194             # there is no equals sign). Only the leftmost equals is considered. This
1195             # is a restriction.
1196             sub _location_is_in_right_hand_side_of_assignment {
1197 36     36   1444 my ( $elem, $inner_elem ) = @_;
1198 36         89 my $inner_loc = $inner_elem->location();
1199 36         378 my $kid = $elem->schild( 0 );
1200 36         435 while ( $kid ) {
1201 111 100 100     1580 $kid->isa( 'PPI::Token::Operator' )
1202             and q{=} eq $kid->content()
1203             or next;
1204 27         154 my $l = $kid->location();
1205 27 50       283 $l->[LOCATION_LINE] > $inner_loc->[LOCATION_LINE]
1206             and return;
1207 27 50 66     82 $l->[LOCATION_LINE] == $inner_loc->[LOCATION_LINE]
1208             and $l->[LOCATION_CHARACTER] >= $inner_loc->[LOCATION_CHARACTER]
1209             and return;
1210 27         91 return $inner_elem->descendant_of( $elem );
1211             } continue {
1212 84         227 $kid = $kid->snext_sibling();
1213             }
1214 9         214 return;
1215             }
1216              
1217             # END OF CODE THAT ABSOLUTELY SHOULD NOT BE HERE
1218              
1219             #-----------------------------------------------------------------------------
1220              
1221             1;
1222              
1223             __END__
1224              
1225             #-----------------------------------------------------------------------------
1226              
1227             =pod
1228              
1229             =head1 NAME
1230              
1231             Perl::Critic::Policy::Variables::ProhibitUnusedVarsStricter - Don't ask for storage you don't need.
1232              
1233             =head1 AFFILIATION
1234              
1235             This Policy is stand-alone, and is not part of the core
1236             L<Perl::Critic|Perl::Critic>.
1237              
1238             =head1 NOTE
1239              
1240             As of version 0.099_001, the logic that recognizes variables
1241             interpolated into double-quotish strings has been refactored into module
1242             L<PPIx::QuoteLike|PPIx::QuoteLike>.
1243              
1244             =head1 DESCRIPTION
1245              
1246             Unused variables clutter code and require the reader to do mental
1247             bookkeeping to figure out if the variable is actually used or not.
1248              
1249             Right now, this only looks for lexical variables which are unused other
1250             than in the statement that declares them.
1251              
1252             my $x; # not ok, assuming no other appearances.
1253             my @y = (); # not ok, assuming no other appearances.
1254             our $z; # ok, global.
1255             local $w; # ok, global.
1256              
1257             This policy is a variant on the core policy
1258             L<Perl::Critic::Policy::Variables::ProhibitUnusedVariables|Perl::Critic::Policy::Variables::ProhibitUnusedVariables>
1259             which attempts to be more strict in its checking of whether a variable
1260             is used. The specific differences are:
1261              
1262             * An attempt is made to take into account the scope of the declaration.
1263              
1264             * An attempt is made to find variables which are interpolated into
1265             double-quotish strings (including regexes) and here documents.
1266              
1267             * An attempt is made to find variables which are used in regular
1268             expression C<(?{...})> and C<(??{...})> constructions, and in the
1269             replacement portion of C<s/.../.../e>.
1270              
1271             This policy intentionally does not report variables as unused if the
1272             code takes a reference to the variable, even if it is otherwise unused.
1273             For example things like
1274              
1275             \( my $foo = 'bar' )
1276             \do{ my $foo => 'bar' }
1277              
1278             will not be reported as a violation even if C<$foo> is otherwise unused.
1279             The reason is that this is an idiom for making a reference to a mutable
1280             string when all you have is an immutable string. This policy does not
1281             check to see if anything is done with the reference.
1282              
1283             This policy also does not detect unused variables declared inside
1284             various odd corners such as
1285              
1286             s///e
1287             qr{(?{...})}
1288             qr{(??{...})}
1289             "@{[ ... ]}"
1290             ( $foo, my $bar ) = ( 1, 2 )
1291              
1292             Most of these are because the PPI parse of the original document does
1293             not include the declarations. The list assignment is missed because PPI
1294             does not parse it as containing a
1295             L<PPI::Statement::Variable|PPI::Statement::Variable>. However, variables
1296             B<used> inside such constructions B<will> be detected.
1297              
1298             =head1 CONFIGURATION
1299              
1300             This policy supports the following configuration items:
1301              
1302             =head2 allow_unused_subroutine_arguments
1303              
1304             By default, this policy prohibits unused subroutine arguments -- that
1305             is, unused variables on the right-hand side of such simple assignments
1306             as
1307              
1308             my ( $foo ) = @_;
1309             my $bar = shift;
1310             my $baz = shift @_;
1311             my $burfle = $_[0];
1312              
1313             If you wish to allow unused variables in this case, you can add a block
1314             like this to your F<.perlcriticrc> file:
1315              
1316             [Variables::ProhibitUnusedVarsStricter]
1317             allow_unused_subroutine_arguments = 1
1318              
1319             =head2 prohibit_reference_only_variables
1320              
1321             By default, this policy allows otherwise-unused variables if the code
1322             takes a reference to the variable when it is created. If you wish to
1323             declare a violation in this case, you can add a block like this to your
1324             F<.perlcriticrc> file:
1325              
1326             [Variables::ProhibitUnusedVarsStricter]
1327             prohibit_reference_only_variables = 1
1328              
1329             =head2 prohibit_returned_lexicals
1330              
1331             By default, this policy allows otherwise-unused variables if they are
1332             being returned from a subroutine, under the presumption that they are
1333             going to be used as lvalues by the caller. If you wish to declare a
1334             violation in this case, you can add a block like this to your
1335             F<.perlcriticrc> file:
1336              
1337             [Variables::ProhibitUnusedVarsStricter]
1338             prohibit_returned_lexicals = 1
1339              
1340             =head2 allow_if_computed_by
1341              
1342             You may wish to allow variables to be unused when computed in certain
1343             ways. For example, you might want to allow place-holder variables in a
1344             list computed by C<stat()> or C<unpack()>. Or you may be doing
1345             end-of-scope detection with something like
1346             C<< my $foo = Scope::Guard->new( \&end_of_scope ) >>. To ignore all
1347             these, you can add a block like this to your F<.perlcriticrc> file:
1348              
1349             [Variables::ProhibitUnusedVarsStricter]
1350             allow_if_computed_by = stat unpack Scope::Guard
1351              
1352             This property takes as its value a whitespace-delimited list of class or
1353             subroutine names. Nothing complex is done to implement this -- the
1354             policy simply looks at the first word after the equals sign, if any.
1355              
1356             =head2 allow_state_in_expression
1357              
1358             By default, this policy handles C<state> variables as any other lexical,
1359             and a violation is declared if they appear only in the statement that
1360             declares them.
1361              
1362             One might, however, do something like
1363              
1364             state $foo = compute_foo() or do_something_else();
1365              
1366             In this case, C<compute_foo()> is called only once, but if it returns a
1367             false value C<do_something_else()> will be executed every time this
1368             statement is encountered.
1369              
1370             If you wish to allow such code, you can add a block like this to your
1371             F<.perlcriticrc> file:
1372              
1373             [Variables::ProhibitUnusedVarsStricter]
1374             allow_state_in_expression = 1
1375              
1376             This allows an otherwise-unused state variable if its value appears to
1377             be used in an expression -- that is, if its declaration is followed by a
1378             low-precedence boolean, or one of its ancestors is preceded or followed
1379             by any operator. The latter means that something like
1380              
1381             my $bar = ( state $foo = compute_foo() ) + 42;
1382              
1383             will be accepted.
1384              
1385             =head2 check_catch
1386              
1387             Under ordinary circumstances the C<$err> variable in
1388              
1389             try {
1390             ...
1391             } catch ( $err ) {
1392             ...
1393             }
1394              
1395             will be invisible to this policy because, although it is in fact the
1396             declaration of a lexical variable, the absence of a C<my> means it does
1397             not look like one to L<PPI|PPI>. If you want to test these, you can add
1398             a block like this to your F<.perlcriticrc> file:
1399              
1400             [Variables::ProhibitUnusedVarsStricter]
1401             check_catch = 1
1402              
1403             This option is not on by default because there appears to be no way to
1404             define a C<catch()> block without a variable, whether or not you intend
1405             to use it.
1406              
1407             B<Caveat:> if L<PPI|PPI> ever starts recognizing C<catch( $foo )> as
1408             containing a L<PPI::Statement::Variable|PPI::Statement::Variable>, this
1409             configuration variable will become moot, as the extra logic will no
1410             longer be needed. As soon as I recognize this has happened (and there
1411             B<is> an author test for it) I will document this configuration item as
1412             a no-op, deprecate it, and probably eventually retract it.
1413              
1414             =head1 AVOIDING UNUSED VARIABLES
1415              
1416             There are situations in Perl where eliminating unused variables is
1417             less straightforward than simply deleting them:
1418              
1419             =head2 List Assignments
1420              
1421             This situation typically (I believe) comes up when your code gets handed
1422             a list, and is not interested in all values in the list. You could, of
1423             course, assign the whole thing to an array and then cherry-pick the
1424             array, but there are less-obvious solutions that avoid the extra
1425             assignment.
1426              
1427             For the purpose of this discussion, I will assume code which calls the
1428             C<localtime()> built-in, but is only interested in day, month, and year.
1429             The cut-and-paste implementation (direct from C<perldoc -f localtime>,
1430             or L<https://perldoc.pl/functions/localtime> if you prefer) is:
1431              
1432             # 0 1 2 3 4 5 6 7 8
1433             my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
1434             localtime();
1435              
1436             Now, you can trivially eliminate the variables after C<$year>, but that
1437             still leaves
1438              
1439             # 0 1 2 3 4 5
1440             my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
1441              
1442             with C<$sec>, C<$min>, and C<$hour> assigned-to but unused. There are
1443             two ways I know of to eliminate these:
1444              
1445             =head3 Assign to C<undef>
1446              
1447             On the left-hand side of a list assignment, C<undef> causes the
1448             corresponding right-hand value to be ignored. This makes our example
1449             look like
1450              
1451             # 0 1 2 3 4 5
1452             my (undef,undef,undef,$mday,$mon,$year) = localtime();
1453              
1454             =head2 Slice the Right-Hand Side
1455              
1456             The unwanted values can also be eliminated by slicing the right-hand
1457             side of the assignment. This looks like
1458              
1459             # 3 4 5
1460             my ($mday,$mon,$year) = ( localtime() )[ 3 .. 5 ];
1461              
1462             or, if you prefer,
1463              
1464             # 3 4 5
1465             my ($mday,$mon,$year) = ( localtime() )[ 3, 4, 5 ];
1466              
1467             =head1 SUPPORT
1468              
1469             Support is by the author. Please file bug reports at
1470             L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perl-Critic-Policy-Variables-ProhibitUnusedVarsStricter>,
1471             L<https://github.com/trwyant/perl-Perl-Critic-Policy-Variables-ProhibitUnusedVarsStricter/issues>, or in
1472             electronic mail to the author.
1473              
1474             =head1 AUTHOR
1475              
1476             Thomas R. Wyant, III F<wyant at cpan dot org>
1477              
1478             =head1 COPYRIGHT
1479              
1480             Copyright (C) 2012-2021 Thomas R. Wyant, III
1481              
1482             =head1 LICENSE
1483              
1484             This program is free software; you can redistribute it and/or modify it
1485             under the same terms as Perl 5.10.0. For more details, see the full text
1486             of the licenses in the directory LICENSES.
1487              
1488             This program is distributed in the hope that it will be useful, but
1489             without any warranty; without even the implied warranty of
1490             merchantability or fitness for a particular purpose.
1491              
1492             =cut
1493              
1494             # Local Variables:
1495             # mode: cperl
1496             # cperl-indent-level: 4
1497             # fill-column: 72
1498             # indent-tabs-mode: nil
1499             # c-indentation-style: bsd
1500             # End:
1501             # ex: set ts=8 sts=4 sw=4 tw=72 ft=perl expandtab shiftround :