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