File Coverage

blib/lib/Perl/Critic/Policy/Community/MultidimensionalArrayEmulation.pm
Criterion Covered Total %
statement 46 47 97.8
branch 22 24 91.6
condition 43 54 79.6
subroutine 12 13 92.3
pod 4 5 80.0
total 127 143 88.8


line stmt bran cond sub pod time code
1              
2             use strict;
3 1     1   365 use warnings;
  1         3  
  1         25  
4 1     1   4  
  1         3  
  1         22  
5             use Perl::Critic::Utils qw(:severities :classification :ppi);
6 1     1   6 use parent 'Perl::Critic::Policy';
  1         1  
  1         57  
7 1     1   311  
  1         2  
  1         4  
8             use List::Util 'any';
9 1     1   63  
  1         2  
  1         68  
10             our $VERSION = 'v1.0.3';
11              
12             use constant DESC => 'Use of multidimensional array emulation in hash subscript';
13 1     1   6 use constant EXPL => 'A list in a hash subscript used with the $ sigil triggers Perl 4 multidimensional array emulation. Nest structures using references instead.';
  1         1  
  1         45  
14 1     1   4  
  1         2  
  1         404  
15              
16 4     4 0 15876 my ($self, $elem) = @_;
17 13     13 1 116 return () unless $elem->complete and $elem->braces eq '{}';
18 0     0 1 0
19 4     4 1 69722 my @contents = $elem->schildren;
20             @contents = $contents[0]->schildren if @contents == 1 and $contents[0]->isa('PPI::Statement::Expression');
21            
22 34     34 1 2593 # check for function call with no parentheses; following args won't trigger MAE
23 34 100 66     76 if (@contents > 1 and $contents[0]->isa('PPI::Token::Word') and !$contents[1]->isa('PPI::Structure::List')
24             and !($contents[1]->isa('PPI::Token::Operator') and ($contents[1] eq ',' or $contents[1] eq '=>'))) {
25 30         415 return ();
26 30 50 33     306 }
27            
28             # check if contains top level , or multi-word qw
29 30 100 100     342 return () unless any {
      100        
      66        
      100        
30             ($_->isa('PPI::Token::Operator') and ($_ eq ',' or $_ eq '=>')) or
31 1         4 ($_->isa('PPI::Token::QuoteLike::Words') and (my @words = $_->literal) > 1)
32             } @contents;
33            
34             # check if it's a postderef slice
35             my $prev = $elem->sprevious_sibling;
36 51 100 66 51   284 return () if $prev and $prev->isa('PPI::Token::Cast') and ($prev eq '@' or $prev eq '%');
      100        
      100        
37            
38 29 100       191 # check if it's a slice
39             my ($cast, $found_symbol);
40             $prev = $elem;
41 21         448 while ($prev = $prev->sprevious_sibling) {
42 21 50 66     460 last if $found_symbol and !$prev->isa('PPI::Token::Cast');
      66        
      66        
43             if ($prev->isa('PPI::Token::Symbol')) {
44             $cast = $prev->raw_type;
45 19         35 $found_symbol = 1;
46 19         32 } elsif ($prev->isa('PPI::Structure::Block')) {
47 19         36 $found_symbol = 1;
48 34 100 100     642 } elsif ($found_symbol and $prev->isa('PPI::Token::Cast')) {
49 33 100 66     155 $cast = $prev;
    100          
    100          
50 12         31 } else {
51 12         72 last unless $prev->isa('PPI::Structure::Subscript')
52             or ($prev->isa('PPI::Token::Operator') and $prev eq '->');
53 5         16 }
54             }
55 8         23 return () if $cast and ($cast eq '@' or $cast eq '%');
56            
57 8 100 66     41 return $self->violation(DESC, EXPL, $elem);
      66        
58             }
59              
60             1;
61 19 100 100     288  
      100        
62             =head1 NAME
63 13         95  
64             Perl::Critic::Policy::Community::MultidimensionalArrayEmulation - Don't use
65             multidimensional array emulation
66              
67             =head1 DESCRIPTION
68              
69             When used with the C<@> or C<%> sigils, a list in a hash subscript (C<{}>) will
70             access multiple elements of the hash as a slice. With the C<$> sigil however,
71             it accesses the single element at the key defined by joining the list with the
72             subscript separator C<$;>. This feature is known as
73             L<perldata/"Multi-dimensional array emulation"> and provided a way to emulate
74             a multidimensional structure before Perl 5 introduced references. Perl now
75             supports true multidimensional structures, so this feature is now unnecessary
76             in most cases.
77              
78             $foo{$x,$y,$z} # not ok
79             $foo{qw(a b c)} # not ok
80             $foo{$x}{$y}{$z} # ok
81             @foo{$x,$y,$z} # ok
82              
83             =head1 AFFILIATION
84              
85             This policy is part of L<Perl::Critic::Community>.
86              
87             =head1 CONFIGURATION
88              
89             This policy is not configurable except for the standard options.
90              
91             =head1 AUTHOR
92              
93             Dan Book, C<dbook@cpan.org>
94              
95             =head1 COPYRIGHT AND LICENSE
96              
97             Copyright 2015, Dan Book.
98              
99             This library is free software; you may redistribute it and/or modify it under
100             the terms of the Artistic License version 2.0.
101              
102             =head1 SEE ALSO
103              
104             L<Perl::Critic>