File Coverage

blib/lib/Perl/Critic/Policy/Community/DollarAB.pm
Criterion Covered Total %
statement 37 38 97.3
branch 8 8 100.0
condition 14 15 93.3
subroutine 11 12 91.6
pod 4 5 80.0
total 74 78 94.8


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::Community::DollarAB;
2              
3 1     1   540 use strict;
  1         3  
  1         32  
4 1     1   5 use warnings;
  1         3  
  1         33  
5              
6 1     1   6 use Perl::Critic::Utils qw(:severities :classification :ppi);
  1         2  
  1         95  
7 1     1   402 use parent 'Perl::Critic::Policy';
  1         4  
  1         7  
8              
9             our $VERSION = 'v1.0.1';
10              
11 1     1   83 use constant DESC => 'Using $a or $b outside sort()';
  1         2  
  1         76  
12 1     1   6 use constant EXPL => '$a and $b are special package variables for use in sort() and related functions. Declaring them as lexicals like "my $a" may break sort(). Use different variable names.';
  1         2  
  1         395  
13              
14             sub supported_parameters {
15             (
16             {
17 9     9 0 36454 name => 'extra_pair_functions',
18             description => 'Non-standard functions in which to allow $a and $b',
19             behavior => 'string list',
20             },
21             )
22             }
23              
24 4     4 1 46 sub default_severity { $SEVERITY_HIGH }
25 0     0 1 0 sub default_themes { 'community' }
26 9     9 1 103187 sub applies_to { 'PPI::Token::Symbol' }
27              
28             my @sorters = qw(sort reduce pairgrep pairfirst pairmap pairwise);
29              
30             sub violates {
31 37     37 1 1462 my ($self, $elem) = @_;
32 37 100 100     111 return () unless $elem->symbol eq '$a' or $elem->symbol eq '$b';
33              
34 31         2040 my %sorters_hash = map { ($_ => 1) } @sorters, keys %{$self->{_extra_pair_functions}};
  194         451  
  31         93  
35 31         103 my $found = $self->_find_sorter($elem, \%sorters_hash);
36            
37 31 100       108 return $self->violation(DESC, EXPL, $elem) unless $found;
38 27         105 return ();
39             }
40              
41             sub _find_sorter {
42 33     33   78 my ($self, $elem, $sorters) = @_;
43            
44 33         100 my $outer = $elem->parent;
45 33   100     365 $outer = $outer->parent until !$outer or $outer->isa('PPI::Structure::Block');
46 33 100       305 return '' unless $outer;
47            
48             # Find function or method call (assumes block/sub is first argument)
49 29         84 my $function = $outer->previous_token;
50             $function = $function->previous_token until !$function
51 29   66     968 or ($function->isa('PPI::Token::Word') and $function =~ m/([^:]+)\z/ and exists $sorters->{$1});
      100        
      100        
52 29 100       4105 return $self->_find_sorter($outer) unless $function;
53 27         71 return $function;
54             }
55              
56             1;
57              
58             =head1 NAME
59              
60             Perl::Critic::Policy::Community::DollarAB - Don't use $a or $b as variable
61             names outside sort
62              
63             =head1 DESCRIPTION
64              
65             The special variables C<$a> and C<$b> are reserved for C<sort()> and similar
66             functions which assign to them to iterate over pairs of values. These are
67             global variables, and declaring them as lexical variables with C<my> to use
68             them outside this context can break usage of these functions. Use different
69             names for your variables.
70              
71             my $a = 1; # not ok
72             my $abc = 1; # ok
73             sort { $a <=> $b } (3,2,1); # ok
74              
75             =head1 AFFILIATION
76              
77             This policy is part of L<Perl::Critic::Community>.
78              
79             =head1 CONFIGURATION
80              
81             This policy can be configured to allow C<$a> and C<$b> in additional functions,
82             by putting an entry in a C<.perlcriticrc> file like this:
83              
84             [Community::DollarAB]
85             extra_pair_functions = pairfoo pairbar
86              
87             =head1 AUTHOR
88              
89             Dan Book, C<dbook@cpan.org>
90              
91             =head1 COPYRIGHT AND LICENSE
92              
93             Copyright 2015, Dan Book.
94              
95             This library is free software; you may redistribute it and/or modify it under
96             the terms of the Artistic License version 2.0.
97              
98             =head1 SEE ALSO
99              
100             L<Perl::Critic>