File Coverage

blib/lib/Perl/Lint/Policy/ControlStructures/ProhibitMutatingListFunctions.pm
Criterion Covered Total %
statement 153 158 96.8
branch 114 142 80.2
condition 49 63 77.7
subroutine 6 6 100.0
pod 0 1 0.0
total 322 370 87.0


line stmt bran cond sub pod time code
1             package Perl::Lint::Policy::ControlStructures::ProhibitMutatingListFunctions;
2 133     133   75646 use strict;
  133         168  
  133         3087  
3 133     133   382 use warnings;
  133         161  
  133         2338  
4 133     133   756 use Perl::Lint::Constants::Type;
  133         151  
  133         60673  
5 133     133   575 use parent "Perl::Lint::Policy";
  133         174  
  133         563  
6              
7             use constant {
8 133         158639 DESC => q{Don't modify $_ in list functions},
9             EXPL => [114],
10 133     133   6799 };
  133         171  
11              
12             my %_target_functions = (
13             map => 1,
14             grep => 1,
15             first => 1,
16             any => 1,
17             all => 1,
18             none => 1,
19             notall => 1,
20             true => 1,
21             false => 1,
22             firstidx => 1,
23             first_index => 1,
24             lastidx => 1,
25             last_index => 1,
26             insert_after => 1,
27             insert_after_string => 1,
28             );
29              
30             my %assigner = (
31             &ASSIGN => 1,
32             &POWER_EQUAL => 1,
33             &ADD_EQUAL => 1,
34             &MUL_EQUAL => 1,
35             &AND_BIT_EQUAL => 1,
36             &SUB_EQUAL => 1,
37             &DIV_EQUAL => 1,
38             &OR_BIT_EQUAL => 1,
39             &MOD_EQUAL => 1,
40             &NOT_BIT_EQUAL => 1,
41             &DEFAULT_EQUAL => 1,
42             &AND_EQUAL => 1,
43             &OR_EQUAL => 1,
44             &STRING_ADD_EQUAL => 1,
45             &LEFT_SHIFT_EQUAL => 1,
46             &RIGHT_SHIFT_EQUAL => 1,
47             );
48              
49             my %reg_replace_token_types = (
50             ®_REPLACE => 1,
51             ®_ALL_REPLACE => 1,
52             );
53              
54             sub evaluate {
55 17     17 0 28 my ($class, $file, $tokens, $src, $args) = @_;
56              
57 17         108 my %target_functions = %_target_functions;
58 17 100       44 if (my $this_policies_arg = $args->{prohibit_mutating_list_functions}) {
59 3 100       12 if (my $list_funcs = $this_policies_arg->{list_funcs}) {
60 2         6 %target_functions = ();
61 2         19 $target_functions{$_} = 1 for split /\s+/, $list_funcs;
62             }
63              
64 3 100       11 if (my $add_list_funcs = $this_policies_arg->{add_list_funcs}) {
65 1         9 $target_functions{$_} = 1 for split /\s+/, $add_list_funcs;
66             }
67             }
68              
69 17         19 my @violations;
70             # use Data::Dumper::Concise; warn Dumper($tokens); # TODO remove
71 17         43 for (my $i = 0, my $token_type, my $token_data; my $token = $tokens->[$i]; $i++) {
72 685         471 $token_type = $token->{type};
73 685         429 $token_data = $token->{data};
74              
75 685 100 100     1864 if ($token_type == BUILTIN_FUNC || $token_type == KEY) {
76 108 100       143 if ($target_functions{$token_data}) {
77 106 50       173 $token = $tokens->[++$i] or last;
78 106 50       134 if ($token->{type} != LEFT_BRACE) {
79 0         0 next;
80             }
81              
82 106         64 my $lbnum = 1;
83 106         157 for ($i++; $token = $tokens->[$i]; $i++) {
84 195         125 $token_type = $token->{type};
85 195         144 $token_data = $token->{data};
86              
87 195 100 66     1101 if ($token_type == LEFT_BRACE) {
    100 100        
    100 100        
    100 100        
    100          
    100          
88 1         2 $lbnum++;
89             }
90             elsif ($token_type == RIGHT_BRACE) {
91 9 50       25 last if --$lbnum <= 0;
92             }
93             elsif ($token_type == SPECIFIC_VALUE && $token_data eq '$_') {
94 44 50       65 $token = $tokens->[++$i] or last;
95 44         31 $token_type = $token->{type};
96              
97 44 100       55 if ($token_type == RIGHT_BRACE) {
98 2 50       9 last if --$lbnum <= 0;
99             }
100              
101             # for assign
102 42 100 100     132 if (
      100        
103             $assigner{$token_type} ||
104             $token_type == PLUSPLUS || $token_type == MINUSMINUS
105             ) {
106             push @violations, {
107             filename => $file,
108             line => $token->{line},
109 21         56 description => DESC,
110             explanation => EXPL,
111             policy => __PACKAGE__,
112             };
113 21         41 last;
114             }
115              
116             # for replace by regex
117 21 100       34 if ($token_type == REG_OK) {
118 19 50       31 $token = $tokens->[++$i] or last;
119 19         15 $token_type = $token->{type};
120              
121 19 50       26 if ($reg_replace_token_types{$token_type}) {
122 19         13 my $is_replace_to_empty = 0;
123 19         13 my $is_equal_src_between_dst = 0;
124              
125 19         12 my $replace_to;
126             my $replace_from;
127 19         28 for ($i++; $token = $tokens->[$i]; $i++) {
128 76         56 $token_type = $token->{type};
129 76 100       130 if ($token_type == REG_REPLACE_FROM) {
    100          
130 19         27 $replace_from = $token->{data};
131             }
132             elsif ($token_type == REG_REPLACE_TO) {
133 19         14 $replace_to = $token->{data};
134 19 100       29 if ($replace_to eq '') {
    100          
135 8         7 $is_replace_to_empty = 1;
136             }
137             elsif ($replace_to eq $replace_from) {
138 8         5 $is_equal_src_between_dst =1;
139             }
140 19         17 $i++; # at last reg delim
141 19         14 last;
142             }
143             }
144              
145 19   100     39 my $is_replaced = !$is_replace_to_empty && !$is_equal_src_between_dst;
146 19 50       27 if ($token = $tokens->[++$i]) {
147 19 100 66     70 if ($token->{type} == REG_OPT and my @opts = $token->{data} =~ /([cdrs])/g) {
148 12         12 my %opts = map {$_ => 1} @opts;
  12         20  
149              
150 12 50       24 if ($opts{r}) {
151 0         0 $is_replaced = 0;
152             }
153             else {
154 12 100       13 if ($opts{c}) {
155 4         6 $is_replaced = $is_equal_src_between_dst;
156             }
157              
158 12 100       15 if ($opts{d}) {
159 4         5 $is_replaced = $is_replace_to_empty;
160             }
161              
162 12 100       18 if ($opts{s}) {
163 4   66     11 $is_replaced = $is_replace_to_empty || $is_equal_src_between_dst;
164             }
165             }
166             }
167             }
168              
169 19 100       26 if (!$is_replaced) {
170 8         15 last;
171             }
172              
173             push @violations, {
174             filename => $file,
175             line => $token->{line},
176 11         29 description => DESC,
177             explanation => EXPL,
178             policy => __PACKAGE__,
179             };
180 11         24 last;
181             }
182             }
183             }
184             elsif ($token_type == PLUSPLUS || $token_type == MINUSMINUS) {
185 2 50       5 $token = $tokens->[++$i] or last;
186 2 50 33     11 if ($token->{type} == SPECIFIC_VALUE && $token->{data} eq '$_') {
187             push @violations, {
188             filename => $file,
189             line => $token->{line},
190 2         7 description => DESC,
191             explanation => EXPL,
192             policy => __PACKAGE__,
193             };
194 2         4 last;
195             }
196             }
197             elsif ($reg_replace_token_types{$token_type}) {
198 41 50       63 my $before_token = $tokens->[$i-1] or next;
199 41 50       56 if ($before_token->{type} != REG_OK) {
200 41         29 my $is_replace_to_empty = 0;
201 41         20 my $is_equal_src_between_dst = 0;
202              
203 41         28 my $replace_to;
204             my $replace_from;
205 41         58 for ($i++; $token = $tokens->[$i]; $i++) {
206 164         105 $token_type = $token->{type};
207 164 100       264 if ($token_type == REG_REPLACE_FROM) {
    100          
208 41         55 $replace_from = $token->{data};
209             }
210             elsif ($token_type == REG_REPLACE_TO) {
211 41         29 $replace_to = $token->{data};
212 41 100       57 if ($replace_to eq '') {
    100          
213 16         13 $is_replace_to_empty = 1;
214             }
215             elsif ($replace_to eq $replace_from) {
216 16         14 $is_equal_src_between_dst =1;
217             }
218 41         26 $i++; # at last reg delim
219 41         29 last;
220             }
221             }
222              
223 41   100     76 my $is_replaced = !$is_replace_to_empty && !$is_equal_src_between_dst;
224 41 50       55 if ($token = $tokens->[++$i]) {
225 41 100 100     163 if ($token->{type} == REG_OPT and my @opts = $token->{data} =~ /([cdrs])/g) {
226 27         26 my %opts = map {$_ => 1} @opts;
  27         45  
227              
228 27 100       34 if ($opts{r}) {
229 3         5 $is_replaced = 0;
230             }
231             else {
232 24 100       32 if ($opts{c}) {
233 8         6 $is_replaced = $is_equal_src_between_dst;
234             }
235              
236 24 100       27 if ($opts{d}) {
237 8         8 $is_replaced = $is_replace_to_empty;
238             }
239              
240 24 100       36 if ($opts{s}) {
241 8   66     20 $is_replaced = $is_replace_to_empty || $is_equal_src_between_dst;
242             }
243             }
244             }
245             }
246              
247 41 100       51 if (!$is_replaced) {
248 19         35 last;
249             }
250              
251             push @violations, {
252             filename => $file,
253             line => $token->{line},
254 22         51 description => DESC,
255             explanation => EXPL,
256             policy => __PACKAGE__,
257             };
258 22         47 last;
259             }
260             }
261             elsif ($token_type == KEY || $token_type == BUILTIN_FUNC || $token_type == DEFAULT) {
262 21 100 100     64 if ($token_data eq 'chop' || $token_data eq 'chomp') {
    100          
    100          
263 13 50       41 $token = $tokens->[++$i] or last;
264 13         47 $token_type = $token->{type};
265 13         11 $token_data = $token->{data};
266 13 100 66     56 if ($token_type == SEMI_COLON || $token_type == RIGHT_BRACE) {
    100 66        
    100          
267             push @violations, {
268             filename => $file,
269             line => $token->{line},
270 2         8 description => DESC,
271             explanation => EXPL,
272             policy => __PACKAGE__,
273             };
274 2         5 last;
275             }
276             elsif ($token_type == SPECIFIC_VALUE && $token_data eq '$_') {
277             push @violations, {
278             filename => $file,
279             line => $token->{line},
280 4         16 description => DESC,
281             explanation => EXPL,
282             policy => __PACKAGE__,
283             };
284 4         9 last;
285             }
286             elsif ($token_type == LEFT_PAREN) {
287 6 50       11 $token = $tokens->[++$i] or last;
288 6 100       9 if ($token->{type} == RIGHT_PAREN) {
289             push @violations, {
290             filename => $file,
291             line => $token->{line},
292 2         7 description => DESC,
293             explanation => EXPL,
294             policy => __PACKAGE__,
295             };
296 2         6 last;
297             }
298              
299 4         5 my $lpnum = 1;
300 4         7 for (; $token = $tokens->[$i]; $i++) {
301 4         5 $token_type = $token->{type};
302              
303 4 50 33     22 if ($token_type == LEFT_PAREN) {
    50          
    50          
304 0         0 $lpnum++;
305             }
306             elsif ($token_type == RIGHT_PAREN) {
307 0 0       0 last if --$lpnum <= 0;
308             }
309             elsif ($token_type == SPECIFIC_VALUE && $token->{data} eq '$_') {
310             push @violations, {
311             filename => $file,
312             line => $token->{line},
313 4         13 description => DESC,
314             explanation => EXPL,
315             policy => __PACKAGE__,
316             };
317 4         9 last;
318             }
319             }
320             }
321             }
322             elsif ($token_data eq 'undef') {
323 6 50       11 $token = $tokens->[++$i] or last;
324 6         6 $token_type = $token->{type};
325 6         7 $token_data = $token->{data};
326 6 100 66     22 if ($token_type == SPECIFIC_VALUE && $token_data eq '$_') {
    100          
327             push @violations, {
328             filename => $file,
329             line => $token->{line},
330 2         6 description => DESC,
331             explanation => EXPL,
332             policy => __PACKAGE__,
333             };
334 2         7 last;
335             }
336             elsif ($token_type == LEFT_PAREN) {
337 3         2 my $lpnum = 1;
338 3         8 for (; $token = $tokens->[$i]; $i++) {
339 9         6 $token_type = $token->{type};
340              
341 9 100 66     34 if ($token_type == LEFT_PAREN) {
    100          
    100          
342 3         5 $lpnum++;
343             }
344             elsif ($token_type == RIGHT_PAREN) {
345 1 50       5 last if --$lpnum <= 0;
346             }
347             elsif ($token_type == SPECIFIC_VALUE && $token->{data} eq '$_') {
348             push @violations, {
349             filename => $file,
350             line => $token->{line},
351 2         6 description => DESC,
352             explanation => EXPL,
353             policy => __PACKAGE__,
354             };
355 2         4 last;
356             }
357             }
358             }
359             }
360             elsif ($token_data eq 'substr') {
361 1 50       4 $token = $tokens->[++$i] or last;
362              
363 1 50       3 if ($token_type == LEFT_PAREN) {
364 0 0       0 $token = $tokens->[++$i] or last;
365             }
366              
367 1 50 33     7 if ($token->{type} == SPECIFIC_VALUE && $token->{data} eq '$_') {
368             push @violations, {
369             filename => $file,
370             line => $token->{line},
371 1         5 description => DESC,
372             explanation => EXPL,
373             policy => __PACKAGE__,
374             };
375 1         3 last;
376             }
377             }
378             }
379             }
380             }
381             }
382             }
383              
384 17         75 return \@violations;
385             }
386              
387             1;
388