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