File Coverage

blib/lib/Perl/Lint/Policy/RegularExpressions/ProhibitUnusedCapture.pm
Criterion Covered Total %
statement 417 482 86.5
branch 266 360 73.8
condition 90 135 66.6
subroutine 11 12 91.6
pod 0 1 0.0
total 784 990 79.1


line stmt bran cond sub pod time code
1             package Perl::Lint::Policy::RegularExpressions::ProhibitUnusedCapture;
2 133     133   79857 use strict;
  133         167  
  133         3090  
3 133     133   398 use warnings;
  133         189  
  133         2785  
4 133     133   424 use List::Util qw/any all/;
  133         150  
  133         7027  
5 133     133   55053 use Test::Deep::NoTest qw(eq_deeply);
  133         868097  
  133         777  
6 133     133   21731 use Perl::Lint::Constants::Type;
  133         181  
  133         62611  
7 133     133   577 use parent "Perl::Lint::Policy";
  133         168  
  133         638  
8              
9             use constant {
10 133         399080 DESC => 'Only use a capturing group if you plan to use the captured value',
11             EXPL => [252],
12 133     133   7513 };
  133         170  
13              
14             my %ignore_reg_op = (
15             ®_LIST => 1,
16             ®_EXEC => 1,
17             ®_QUOTE => 1,
18             );
19              
20             my @captured_for_each_scope;
21             my $sub_depth;
22             my @violations;
23             my $file;
24             my $tokens;
25             my $just_before_regex_token;
26             my $reg_not_ctx;
27             my $assign_ctx;
28              
29             sub evaluate {
30 49     49 0 62 my $class = shift;
31 49         38 $file = shift;
32 49         40 $tokens = shift;
33 49         710 my ($src, $args) = @_;
34              
35 49         39 my $is_used_english = 0;
36              
37 49         69 @violations = ();
38 49         71 @captured_for_each_scope = ({});
39 49         54 $just_before_regex_token = undef;
40 49         65 $assign_ctx = 'NONE';
41 49         34 $reg_not_ctx = 0;
42              
43 49         45 my %depth_for_each_subs;
44 49         37 my $lbnum_for_scope = 0;
45 49         78 $sub_depth = 0;
46              
47 49         107 TOP: for (my $i = 0, my $token_type, my $token_data; my $token = $tokens->[$i]; $i++) {
48 1508         1150 $token_type = $token->{type};
49 1508         1025 $token_data = $token->{data};
50              
51 1508 100 66     2004 if ($token_type == USED_NAME && $token_data eq 'English') {
52 3         4 $is_used_english = 1;
53 3         5 next;
54             }
55              
56             # to ignore regexp which is not pattern matching
57             # NOTE: Compiler::Lexer handles all of the content of q*{} operator as regexp token
58 1505 100       1861 if ($ignore_reg_op{$token_type}) {
59 9         6 $i += 2; # skip content
60 9         15 next;
61             }
62              
63 1496 100       1552 if ($token_type == ASSIGN) {
64 63 50       167 $token = $tokens->[$i-1] or next;
65 63         68 $token_type = $token->{type};
66              
67 63         53 $assign_ctx = 'ANY'; # XXX Any!?
68              
69 63 100 100     579 if (
    100 100        
    100 100        
    100 66        
      66        
      66        
70             $token_type == GLOBAL_VAR ||
71             $token_type == LOCAL_VAR ||
72             $token_type == VAR
73             ) {
74 13         15 $assign_ctx = 'SUCCESS';
75             }
76             elsif (
77             $token_type == GLOBAL_ARRAY_VAR ||
78             $token_type == LOCAL_ARRAY_VAR ||
79             $token_type == ARRAY_VAR
80             ) {
81 11         11 $assign_ctx = 'UNLIMITED_ARRAY';
82             }
83             elsif (
84             $token_type == GLOBAL_HASH_VAR ||
85             $token_type == LOCAL_HASH_VAR ||
86             $token_type == HASH_VAR
87             ) {
88 1         2 $assign_ctx = 'UNLIMITED';
89             }
90             elsif ($token_type == RIGHT_PAREN) {
91 34         30 $assign_ctx = 'LIMITED';
92              
93 34 50       52 $token = $tokens->[$i-2] or next;
94 34         22 $token_type = $token->{type};
95 34 100       69 if ($token_type == LEFT_PAREN) {
    100          
96 2         3 $assign_ctx = 'UNLIMITED';
97             }
98             elsif ($token_type == DEFAULT) {
99 1 50       3 $token = $tokens->[$i-3] or next;
100 1         1 $token_type = $token->{type};
101 1 50       3 if ($token_type == LEFT_PAREN) {
102 1         2 $assign_ctx = 'UNLIMITED';
103             }
104             }
105             }
106              
107 63 50       100 $token = $tokens->[$i+1] or next;
108 63         42 $token_type = $token->{type};
109 63 100 100     163 if ($token_type == LEFT_BRACE || $token_type == LEFT_BRACKET) {
110 2         3 $assign_ctx = 'UNLIMITED';
111             }
112              
113 63         97 next;
114             }
115              
116 1433 100       1500 if ($token_type == SEMI_COLON) {
117 169         132 $assign_ctx = 'NONE';
118 169         218 next;
119             }
120              
121 1264 100       1496 if ($token_type == REG_NOT) {
122 2         6 $reg_not_ctx = 1;
123 2         4 next;
124             }
125              
126 1262 100       1297 if ($token_type == REG_DOUBLE_QUOTE) {
127 3         3 $i += 2; # jump to string
128 3         4 $token = $tokens->[$i];
129 3         2 $token_type = STRING; # XXX Violence!!
130             # fall through
131             }
132 1262 100 100     2968 if ($token_type == STRING || $token_type == HERE_DOCUMENT) {
133 28         53 my @chars = split //, $token_data;
134 28         24 my $is_var = 0;
135 28         15 my $escaped = 0;
136 28         47 for (my $j = 0; my $char = $chars[$j]; $j++) {
137 83 100       91 if ($escaped) {
138 7 50       15 if ($char =~ /[0-9]/) {
139             # TODO should track follows number
140 0         0 delete $captured_for_each_scope[$sub_depth]->{q<$> . $char};
141             }
142 7         7 $escaped = 0;
143 7         9 next;
144             }
145              
146 76 100       83 if ($is_var) {
147 7 50       13 if ($char =~ /[a-zA-Z_]/) {
148 0         0 my $var_name = $char;
149 0         0 for ($j++; $char = $chars[$j]; $j++) {
150 0 0       0 if ($char !~ /[0-9a-zA-Z_]/) {
151 0         0 $j--;
152 0         0 last;
153             }
154 0         0 $var_name .= $char;
155             }
156              
157 0 0 0     0 if (!$is_used_english) {
    0 0        
158 0         0 next;
159             }
160             elsif (
161             $var_name eq 'LAST_PAREN_MATCH' ||
162             $var_name eq 'LAST_MATCH_END' ||
163             $var_name eq 'LAST_MATCH_START'
164             ) {
165 0         0 $char = '+'; # XXX
166             }
167             else {
168 0         0 next;
169             }
170             }
171              
172 7 100       12 if ($char eq '{') {
173 1         2 my $var_name = '';
174 1         4 for ($j++; $char = $chars[$j]; $j++) {
175 2 100       5 if ($char eq '}') {
176 1         2 last;
177             }
178             else {
179 1         3 $var_name .= $char;
180             }
181             }
182 1         3 delete $captured_for_each_scope[$sub_depth]->{q<$> . $var_name};
183 1         2 next;
184             }
185              
186 6 100 33     18 if ($char =~ /[0-9]/) {
    50          
187             # TODO should track follows number
188 3         7 delete $captured_for_each_scope[$sub_depth]->{q<$> . $char};
189             }
190             elsif (
191             $char eq '+' || $char eq '-'
192             ) {
193 3         3 my $lbnum = 1;
194 3         3 my $captured_name = '';
195              
196 3         3 my $begin_delimiter = '{';
197 3         2 my $end_delimiter = '}';
198 3 50       7 $char = $chars[++$j] or next;
199 3 100       5 if ($char eq '[') {
200 2         2 $begin_delimiter = '[';
201 2         3 $end_delimiter = ']';
202             }
203              
204 3         6 for ($j++; $char = $chars[$j]; $j++) {
205 8 50       17 if ($char eq $begin_delimiter) {
    100          
    50          
206 0         0 $lbnum++;
207             }
208             elsif ($char eq $end_delimiter) {
209 3 50       6 last if --$lbnum <= 0;
210             }
211             elsif ($char ne ' ') {
212 5         8 $captured_name .= $char;
213             }
214             }
215              
216 3 100       5 if ($begin_delimiter eq '[') {
217 2 50       5 $captured_name-- if $captured_name > 0;
218              
219 2         2 my @num_vars = sort {$a cmp $b} grep { $_ =~ /\A\$[0-9]+\Z/} keys %{$captured_for_each_scope[$sub_depth]};
  2         6  
  4         17  
  2         6  
220              
221 2 50       4 if (my $hit = $num_vars[$captured_name]) {
222 2         5 delete $captured_for_each_scope[$sub_depth]->{$hit};
223             }
224             }
225             else {
226 1         2 delete $captured_for_each_scope[$sub_depth]->{$captured_name};
227             }
228             }
229              
230 6         5 $is_var = 0;
231 6         9 next;
232             }
233              
234 69 100       81 if ($char eq '\\') {
235 7         7 $escaped = 1;
236 7         10 next;
237             }
238              
239 62 100       105 if ($char eq q<$>) {
240 6         4 $is_var = 1;
241 6         12 next;
242             }
243             }
244 28         53 next;
245             }
246              
247 1234 100       1335 if ($token_type == REG_REPLACE_TO) {
248 22         16 my $escaped = 0;
249 22         18 my $is_var = 0;
250 22         46 my @re_chars = split //, $token_data;
251 22         39 for (my $j = 0; my $re_char = $re_chars[$j]; $j++) {
252 103 100       112 if ($escaped) {
253 2 100       7 if ($re_char =~ /[0-9]/) {
254             # TODO should track follows number
255 1         2 delete $captured_for_each_scope[$sub_depth]->{q<$> . $re_char};
256             }
257 2         2 $escaped = 0;
258 2         4 next;
259             }
260              
261 101 100       147 if ($is_var) {
262 30 100       70 if ($re_char =~ /[a-zA-Z_]/) {
263 11         9 my $var_name = $re_char;
264 11         19 for ($j++; $re_char = $re_chars[$j]; $j++) {
265 159 100       201 if ($re_char !~ /[0-9a-zA-Z_]/) {
266 11         8 $j--;
267 11         8 last;
268             }
269 148         188 $var_name .= $re_char;
270             }
271              
272 11 100 100     36 if (!$is_used_english) {
    50 66        
273 6         10 next;
274             }
275             elsif (
276             $var_name eq 'LAST_PAREN_MATCH' ||
277             $var_name eq 'LAST_MATCH_END' ||
278             $var_name eq 'LAST_MATCH_START'
279             ) {
280 5         3 $re_char = '+'; # XXX
281             }
282             else {
283 0         0 next;
284             }
285             }
286              
287 24 100       34 if ($re_char eq '{') {
288 2         2 my $var_name = '';
289 2         6 for ($j++; $re_char = $re_chars[$j]; $j++) {
290 7 100       12 if ($re_char eq '}') {
291 2         2 last;
292             }
293             else {
294 5         8 $var_name .= $re_char;
295             }
296             }
297 2         4 delete $captured_for_each_scope[$sub_depth]->{q<$> . $var_name};
298 2         4 next;
299             }
300              
301 22 100 100     67 if ($re_char =~ /[0-9]/) {
    100          
302             # TODO should track follows number
303 7         11 delete $captured_for_each_scope[$sub_depth]->{q<$> . $re_char};
304             }
305             elsif (
306             $re_char eq '+' || $re_char eq '-'
307             ) {
308 10         10 my $lbnum = 1;
309 10         5 my $captured_name = '';
310              
311 10         9 my $begin_delimiter = '{';
312 10         9 my $end_delimiter = '}';
313 10 50       13 $re_char = $re_chars[++$j] or next;
314 10 100       14 if ($re_char eq '[') {
315 8         6 $begin_delimiter = '[';
316 8         6 $end_delimiter = ']';
317             }
318              
319 10         18 for (; $re_char = $re_chars[$j]; $j++) {
320 54 100       95 if ($re_char eq $begin_delimiter) {
    100          
    100          
321 10         13 $lbnum++;
322             }
323             elsif ($re_char eq $end_delimiter) {
324 10 50       22 last if --$lbnum <= 0;
325             }
326             elsif ($re_char ne ' ') {
327 18         22 $captured_name .= $re_char;
328             }
329             }
330              
331 10 100       14 if ($begin_delimiter eq '[') {
332 8 100       17 $captured_name-- if $captured_name > 0;
333              
334 8         7 my @num_vars = sort {$a cmp $b} grep { $_ =~ /\A\$[0-9]+\Z/} keys %{$captured_for_each_scope[$sub_depth]};
  0         0  
  8         30  
  8         19  
335              
336 8 50       15 if (my $hit = $num_vars[$captured_name]) {
337 8         12 delete $captured_for_each_scope[$sub_depth]->{$hit};
338             }
339             }
340             else {
341 2         5 delete $captured_for_each_scope[$sub_depth]->{$captured_name};
342             }
343             }
344              
345 22         16 $is_var = 0;
346 22         36 next;
347             }
348              
349 71 100       86 if ($re_char eq '\\') {
350 2         2 $escaped = 1;
351 2         4 next;
352             }
353              
354 69 100       102 if ($re_char eq q<$>) {
355 23         16 $is_var = 1;
356 23         32 next;
357             }
358             }
359              
360 22         51 next;
361             }
362              
363 1212 100 100     2760 if ($token_type == REG_EXP || $token_type == REG_REPLACE_FROM) {
364 90 100 66     146 if (defined $captured_for_each_scope[$sub_depth] && %{$captured_for_each_scope[$sub_depth]}) {
  90         235  
365             push @violations, {
366             filename => $file,
367             line => $just_before_regex_token->{line},
368 10         34 description => DESC,
369             explanation => EXPL,
370             policy => __PACKAGE__,
371             };
372             }
373              
374 90         94 $captured_for_each_scope[$sub_depth] = {};
375 90         80 $just_before_regex_token = $token;
376              
377 90         188 my @re_chars = split //, $token_data;
378              
379 90         73 my $escaped = 0;
380 90         55 my $lbnum = 0;
381 90         68 my $captured_num = 0;
382 90         139 for (my $j = 0; my $re_char = $re_chars[$j]; $j++) {
383 608 100       685 if ($escaped) {
384 38 100       68 if ($re_char =~ /[0-9]/) {
385             # TODO should track follows number
386 1         3 delete $captured_for_each_scope[$sub_depth]->{q<$> . $re_char};
387             }
388 38         37 $escaped = 0;
389 38         56 next;
390             }
391              
392 570 100       665 if ($re_char eq '\\') {
393 38         28 $escaped = 1;
394 38         57 next;
395             }
396              
397 532 100       550 if ($re_char eq '[') {
398 3         3 $lbnum++;
399 3         4 next;
400             }
401              
402 529 100       545 if ($lbnum > 0) { # in [...]
403 6 100       9 if ($re_char eq ']') {
404 3         3 $lbnum--;
405 3         4 next;
406             }
407              
408 3         5 next;
409             }
410              
411 523 100       850 if ($re_char eq '(') {
412 113         84 my $captured_name = '';
413              
414 113 100 33     282 if ($re_chars[$j+1] eq '?') {
    50          
415 18         19 my $delimiter = $re_chars[$j+2];
416              
417 18 100       28 if ($delimiter eq ':') {
418 3         4 next;
419             }
420              
421 15 100       21 if ($delimiter eq 'P') {
422 3         4 $delimiter = $re_chars[$j+3];
423 3         4 $j++;
424             }
425              
426 15 50 66     29 if ($delimiter eq '<' || $delimiter eq q{'}) {
427 15         23 for ($j += 3; $re_char = $re_chars[$j]; $j++) {
428 60 100 100     198 if (
      100        
      66        
429             ($delimiter eq '<' && $re_char eq '>') ||
430             ($delimiter eq q{'} && $re_char eq q{'})
431             ) {
432 15         13 last;
433             }
434 45         65 $captured_name .= $re_char;
435             }
436              
437              
438 15 50       18 if ($reg_not_ctx) {
439             push @violations, {
440             filename => $file,
441             line => $token->{line},
442 0         0 description => DESC,
443             explanation => EXPL,
444             policy => __PACKAGE__,
445             };
446             }
447             else {
448 15         12 $captured_num++;
449 15         37 $captured_for_each_scope[$sub_depth]->{$captured_name} = 1;
450             }
451             }
452             }
453             elsif ($re_chars[$j+1] ne '?' || $re_chars[$j+2] ne ':') {
454 95 100       89 if ($reg_not_ctx) {
455             push @violations, {
456             filename => $file,
457             line => $token->{line},
458 2         11 description => DESC,
459             explanation => EXPL,
460             policy => __PACKAGE__,
461             };
462             }
463             else {
464 93         68 $captured_num++;
465 93         231 $captured_for_each_scope[$sub_depth]->{q<$> . $captured_num} = 1;
466             }
467             }
468             }
469             }
470              
471 90 100       128 if ($assign_ctx ne 'NONE') {
472 33         22 my $captured = $captured_for_each_scope[$sub_depth];
473              
474 33 100       47 if ($assign_ctx eq 'UNLIMITED_ARRAY') {
475 8 50       6 if (%{$captured || {}}) {
  8 50       21  
476 8 100   10   56 if (all {substr($_, 0, 1) eq q<$> } keys %$captured) {
  10         25  
477 6         7 $captured_for_each_scope[$sub_depth] = {};
478             }
479             }
480 8         35 next;
481             }
482              
483 25         22 $captured_for_each_scope[$sub_depth] = {};
484              
485 25 50       42 my $maybe_reg_opt = $tokens->[$i+2] or next;
486 25 100       41 if ($maybe_reg_opt->{type} == REG_OPT) {
487 6 100 66     23 if ($assign_ctx ne 'UNLIMITED' && $maybe_reg_opt->{data} =~ /g/) {
488             push @violations, {
489             filename => $file,
490             line => $token->{line},
491 2         7 description => DESC,
492             explanation => EXPL,
493             policy => __PACKAGE__,
494             };
495             }
496             }
497              
498 25         61 next;
499             }
500              
501 57         49 $reg_not_ctx = 0;
502              
503 57         122 next;
504             }
505              
506 1122 100       1259 if ($token_type == BUILTIN_FUNC) {
507 78 100 100     195 if ($token_data eq 'grep' || $token_data eq 'map') {
508 7 50       12 $token = $tokens->[++$i] or last;
509 7         7 $token_type = $token->{type};
510              
511 7 50       10 if ($token_type == LEFT_PAREN) {
512 0         0 my $lpnum = 1;
513 0         0 for ($i++; $token = $tokens->[$i]; $i++) {
514 0         0 $token_type = $token->{type};
515 0 0       0 if ($token_type == LEFT_PAREN) {
    0          
516 0         0 $lpnum++;
517             }
518             elsif ($token_type == RIGHT_PAREN) {
519 0 0       0 last if --$lpnum <= 0;
520             }
521             }
522             }
523             else {
524 7         13 for ($i++; $token = $tokens->[$i]; $i++) {
525 78 100       131 if ($token->{type} == SEMI_COLON) {
526 7         5 last;
527             }
528             }
529             }
530              
531 7         14 next;
532             }
533             }
534              
535 1115 100 66     3789 if (
      100        
536             $token_type == BUILTIN_FUNC ||
537             $token_type == METHOD ||
538             $token_type == KEY
539             ) {
540 86         59 my $j = $i + 1;
541 86 50       121 $token = $tokens->[$j] or last;
542 86         68 $token_type = $token->{type};
543 86 100       91 if ($token_type == LEFT_PAREN) {
544 10         8 my $lpnum = 1;
545 10         15 for ($j++; $token = $tokens->[$j]; $j++) {
546 122         73 $token_type = $token->{type};
547 122 50       272 if ($token_type == LEFT_PAREN) {
    100          
    100          
548 0         0 $lpnum++;
549             }
550             elsif ($token_type == RIGHT_PAREN) {
551 10 50       18 last if --$lpnum <= 0;
552             }
553             elsif ($token_type == REG_EXP) {
554 3         6 $token->{type} = -1; # XXX Replace to NOP
555             }
556             }
557             }
558             else {
559 76         115 for (my $j = $i + 1; $token = $tokens->[$j]; $j++) {
560 366         263 $token_type = $token->{type};
561 366 100       682 if ($token_type == SEMI_COLON) {
    100          
562 75         65 last;
563             }
564             elsif ($token_type == REG_EXP) {
565 9         11 $token->{type} = -1; # XXX Replace to NOP
566             }
567             }
568             }
569              
570 86         144 next;
571             }
572              
573 1029 50 66     3661 if (
      66        
574             $token_type == IF_STATEMENT ||
575             $token_type == ELSIF_STATEMENT ||
576             $token_type == UNLESS_STATEMENT
577             ) {
578 27 50       42 $token = $tokens->[++$i] or next;
579              
580 27         26 my @regexs_at_before_and_op;
581             my @regexs_at_after_and_op;
582 0         0 my $and_op_token;
583              
584 27 50       46 if ($token->{type} eq LEFT_PAREN) {
585 27         24 my $lpnum = 1;
586 27         44 for ($i++; $token = $tokens->[$i]; $i++) {
587 158         121 $token_type = $token->{type};
588 158 100 100     630 if ($token_type == LEFT_PAREN) {
    100 100        
    100          
    100          
    100          
589 1         2 $lpnum++;
590             }
591             elsif ($token_type == RIGHT_PAREN) {
592 28 100       45 last if --$lpnum <= 0;
593             }
594             elsif ($token_type == REG_EXP) {
595 29 100       28 if ($and_op_token) {
596 3         6 push @regexs_at_after_and_op, $token;
597             }
598             else {
599 26         48 push @regexs_at_before_and_op, $token;
600             }
601             }
602             elsif ($token_type == AND || $token_type == ALPHABET_AND) {
603 3         6 $and_op_token = $token;
604             }
605             elsif ($ignore_reg_op{$token_type} || $token_type == REG_DOUBLE_QUOTE) { # XXX
606 8         13 $i += 2;
607             }
608             }
609             }
610             else {
611 0         0 for ($i++; $token = $tokens->[$i]; $i++) {
612 0         0 $token_type = $token->{type};
613 0 0 0     0 if ($token_type == SEMI_COLON) {
    0 0        
    0          
    0          
614 0         0 last;
615             }
616             elsif ($token_type == REG_EXP) {
617 0 0       0 if ($and_op_token) {
618 0         0 push @regexs_at_after_and_op, $token;
619             }
620             else {
621 0         0 push @regexs_at_before_and_op, $token;
622             }
623             }
624             elsif ($token_type == AND || $token_type == ALPHABET_AND) {
625 0         0 $and_op_token = $token;
626             }
627             elsif ($ignore_reg_op{$token_type} || $token_type == REG_DOUBLE_QUOTE) { # XXX
628 0         0 $i += 2;
629             }
630             }
631             }
632              
633 27 100       38 if (!@regexs_at_after_and_op) {
634 24         18 my @captured;
635 24         45 for my $regex (@regexs_at_before_and_op) {
636 20         46 $class->_scan_regex($regex, $i);
637              
638 20         23 push @captured, $captured_for_each_scope[$sub_depth];
639 20         32 $captured_for_each_scope[++$sub_depth] = {};
640             }
641              
642 24         19 my $datam = pop @captured;
643 24 100       30 if ($datam) {
644 16         19 for my $cap (@captured) {
645 4 50       11 if (!eq_deeply($datam, $cap)) {
646             # TODO push violation?
647 0         0 next TOP;
648             }
649             }
650             }
651              
652 24         9568 $captured_for_each_scope[$sub_depth] = $datam;
653             }
654             else {
655 3         3 my $is_captured_at_before_and_op = 0;
656 3         4 for my $b_regex (@regexs_at_before_and_op) {
657 3         8 $class->_scan_regex($b_regex, $i);
658              
659 3 50       2 my %captured_this_scope = %{$captured_for_each_scope[$sub_depth] || {}};
  3         12  
660 3 50       6 if (%captured_this_scope) {
661 3         3 $is_captured_at_before_and_op = 1;
662 3         4 last;
663             }
664             }
665              
666 3         4 for my $a_regex (@regexs_at_after_and_op) {
667 3         5 $class->_scan_regex($a_regex, $i);
668              
669 3 50       2 my %captured_this_scope = %{$captured_for_each_scope[$sub_depth] || {}};
  3         11  
670 3 50 33     12 if (%captured_this_scope && $is_captured_at_before_and_op) {
671 3         4 last;
672             }
673             }
674             }
675              
676 27         61 next;
677             }
678              
679 1002 100       1070 if ($token_type == SPECIFIC_VALUE) {
680 53 100       150 if ($token_data =~ /\A\$[0-9]+\Z/) {
681 36         43 delete $captured_for_each_scope[$sub_depth]->{$token_data};
682 36         57 next;
683             }
684              
685 17 100 100     45 if ($token_data eq '$+' || $token_data eq '$-') {
686             # TODO duplicated...
687 10 50       17 $token = $tokens->[$i+2] or next;
688 10         10 $token_data = $token->{data};
689 10 100       22 if ($token_data =~ /\A -? [0-9]+ \Z/x) {
690 6 100       12 $token_data-- if $token_data > 0;
691              
692 6         3 my @num_vars = sort {$a cmp $b} grep { $_ =~ /\A\$[0-9]+\Z/} keys %{$captured_for_each_scope[$sub_depth]};
  0         0  
  2         6  
  6         12  
693              
694 6 100       12 if (my $hit = $num_vars[$token_data]) {
695 2         4 delete $captured_for_each_scope[$sub_depth]->{$hit};
696             }
697             }
698             else {
699 4         7 delete $captured_for_each_scope[$sub_depth]->{$token->{data}};
700             }
701             }
702              
703 17         26 next;
704             }
705              
706 949 100       981 if ($is_used_english) {
707 71 100 100     209 if ($token_type == GLOBAL_VAR || $token_type == VAR) {
708             # TODO duplicated...
709 7 50 100     29 if (
      66        
710             $token_data eq '$LAST_PAREN_MATCH' ||
711             $token_data eq '$LAST_MATCH_END' ||
712             $token_data eq '$LAST_MATCH_START'
713             ) {
714 7 50       12 $token = $tokens->[$i+2] or next;
715 7         8 $token_data = $token->{data};
716 7 100       19 if ($token_data =~ /\A -? [0-9]+ \Z/x) {
717 6 100       12 $token_data-- if $token_data > 0;
718              
719 6         6 my @num_vars = sort {$a cmp $b} grep { $_ =~ /\A\$[0-9]+\Z/} keys %{$captured_for_each_scope[$sub_depth]};
  0         0  
  2         7  
  6         11  
720              
721 6 100       13 if (my $hit = $num_vars[$token_data]) {
722 2         4 delete $captured_for_each_scope[$sub_depth]->{$hit};
723             }
724             }
725             else {
726 1         4 delete $captured_for_each_scope[$sub_depth]->{$token->{data}};
727             }
728             }
729             }
730             }
731              
732 949 100       1077 if ($token_type == FUNCTION_DECL) {
733 5         8 $depth_for_each_subs{$lbnum_for_scope} = 1;
734 5         6 $assign_ctx = 'NONE'; # XXX Umm...
735 5         5 $sub_depth++;
736 5         6 $captured_for_each_scope[$sub_depth] = {};
737 5         10 next;
738             }
739              
740 944 100       1024 if ($token_type == LEFT_BRACE) {
741 50         41 $lbnum_for_scope++;
742 50         64 next;
743             }
744              
745 894 100       1572 if ($token_type == RIGHT_BRACE) {
746 53         35 $lbnum_for_scope--;
747 53 100       76 if (delete $depth_for_each_subs{$lbnum_for_scope}) {
748 5         4 my $regexp_in_return_ctx;
749 5 50       11 if ($token = $tokens->[$i-2]) {
750 5 50       14 if ($token->{type} == REG_EXP) {
    50          
751 0         0 $regexp_in_return_ctx = $token;
752             }
753             elsif ($token = $tokens->[$i-3]) {
754 5 100       8 if ($token->{type} == REG_EXP) {
755 3         5 $regexp_in_return_ctx = $token;
756             }
757             }
758             }
759              
760 5         4 my $captured = pop @captured_for_each_scope;
761 5 50 33     11 if (defined $captured and my %captured = %{$captured}) {
  5         21  
762 5 100       9 if ($regexp_in_return_ctx) {
763             # should check equality between to just before regexp token?
764 3 100   3   14 if (all {substr($_, 0, 1) eq q<$>} keys %captured) {
  3         8  
765 2         8 next;
766             }
767             }
768              
769             push @violations, {
770             filename => $file,
771             line => $just_before_regex_token->{line},
772 3         12 description => DESC,
773             explanation => EXPL,
774             policy => __PACKAGE__,
775             };
776             }
777             }
778 51         85 next;
779             }
780             }
781              
782 49 100       48 if (%{$captured_for_each_scope[-1] || {}}) {
  49 100       115  
783             push @violations, {
784             filename => $file,
785             line => $just_before_regex_token->{line},
786 8         24 description => DESC,
787             explanation => EXPL,
788             policy => __PACKAGE__,
789             };
790             }
791              
792 49         180 return \@violations;
793             }
794              
795             sub _scan_regex {
796 26     26   28 my ($class, $token, $i) = @_;
797              
798 26 100       38 my $line_num = defined $just_before_regex_token ? $just_before_regex_token->{line} : 1;
799 26         21 my $captured = $captured_for_each_scope[$sub_depth];
800 26 100 66     92 if (defined $captured && %$captured) {
801 5         14 push @violations, {
802             filename => $file,
803             line => $line_num,
804             description => DESC,
805             explanation => EXPL,
806             policy => __PACKAGE__,
807             };
808             }
809              
810 26         30 $captured_for_each_scope[$sub_depth] = {};
811 26         18 $just_before_regex_token = $token;
812              
813 26         24 my $token_data = $token->{data};
814              
815 26         52 my @re_chars = split //, $token_data;
816              
817 26         15 my $escaped = 0;
818 26         18 my $lbnum = 0;
819 26         17 my $captured_num = 0;
820 26         43 for (my $j = 0; my $re_char = $re_chars[$j]; $j++) {
821 133 50       143 if ($escaped) {
822 0 0       0 if ($re_char =~ /[0-9]/) {
823             # TODO should track follows number
824 0         0 delete $captured_for_each_scope[$sub_depth]->{q<$> . $re_char};
825             }
826 0         0 $escaped = 0;
827 0         0 return;
828             }
829              
830 133 100       149 if ($re_char eq '\\') {
831 1         2 $escaped = 1;
832 1         4 return;
833             }
834              
835 132 50       140 if ($re_char eq '[') {
836 0         0 $lbnum++;
837 0         0 return;
838             }
839              
840 132 50       146 if ($lbnum > 0) { # in [...]
841 0 0       0 if ($re_char eq ']') {
842 0         0 $lbnum--;
843 0         0 return;
844             }
845              
846 0         0 return;
847             }
848              
849 132 100       210 if ($re_char eq '(') {
850 31         27 my $captured_name = '';
851              
852 31 100 33     82 if ($re_chars[$j+1] eq '?') {
    50          
853 1         2 my $delimiter = $re_chars[$j+2];
854              
855 1 50       4 if ($delimiter eq ':') {
856 0         0 return;
857             }
858              
859 1 50       2 if ($delimiter eq 'P') {
860 0         0 $delimiter = $re_chars[$j+3];
861 0         0 $j++;
862             }
863              
864 1 50 33     5 if ($delimiter eq '<' || $delimiter eq q{'}) {
865 1         3 for ($j += 3; $re_char = $re_chars[$j]; $j++) {
866 4 100 66     21 if (
      33        
      66        
867             ($delimiter eq '<' && $re_char eq '>') ||
868             ($delimiter eq q{'} && $re_char eq q{'})
869             ) {
870 1         2 last;
871             }
872 3         7 $captured_name .= $re_char;
873             }
874              
875 1 50       2 if ($reg_not_ctx) {
876             push @violations, {
877             filename => $file,
878             line => $token->{line},
879 0         0 description => DESC,
880             explanation => EXPL,
881             policy => __PACKAGE__,
882             };
883             }
884             else {
885 1         2 $captured_num++;
886 1         3 $captured_for_each_scope[$sub_depth]->{$captured_name} = 1;
887             }
888             }
889             }
890             elsif ($re_chars[$j+1] ne '?' || $re_chars[$j+2] ne ':') {
891 30 50       34 if ($reg_not_ctx) {
892             push @violations, {
893             filename => $file,
894             line => $token->{line},
895 0         0 description => DESC,
896             explanation => EXPL,
897             policy => __PACKAGE__,
898             };
899             }
900             else {
901 30         16 $captured_num++;
902 30         77 $captured_for_each_scope[$sub_depth]->{q<$> . $captured_num} = 1;
903             }
904             }
905             }
906             }
907              
908 25 50       29 if ($assign_ctx ne 'NONE') {
909 0         0 my $captured = $captured_for_each_scope[$sub_depth];
910              
911 0 0       0 if ($assign_ctx eq 'UNLIMITED_ARRAY') {
912 0 0       0 if (%{$captured || {}}) {
  0 0       0  
913 0 0   0   0 if (all {substr($_, 0, 1) eq q<$> } keys %$captured) {
  0         0  
914 0         0 $captured_for_each_scope[$sub_depth] = {};
915             }
916             }
917 0         0 return;
918             }
919              
920 0         0 $captured_for_each_scope[$sub_depth] = {};
921              
922 0 0       0 my $maybe_reg_opt = $tokens->[$i+2] or return;
923 0 0       0 if ($maybe_reg_opt->{type} == REG_OPT) {
924 0 0 0     0 if ($assign_ctx ne 'UNLIMITED' && $maybe_reg_opt->{data} =~ /g/) {
925             push @violations, {
926             filename => $file,
927             line => $token->{line},
928 0         0 description => DESC,
929             explanation => EXPL,
930             policy => __PACKAGE__,
931             };
932             }
933             }
934              
935 0         0 return;
936             }
937              
938 25         24 $reg_not_ctx = 0;
939              
940 25         35 return;
941             }
942              
943             1;
944