| File: | lib/CheckSpelling/CheckPattern.pm |
| Coverage: | 95.2% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | #! -*-perl-*- | |||||
| 2 | ||||||
| 3 | package CheckSpelling::CheckPattern; | |||||
| 4 | ||||||
| 5 | 3 3 3 | 108544 5 451 | use CheckSpelling::Util; | |||
| 6 | ||||||
| 7 | sub process_line { | |||||
| 8 | 9 | 2332 | my ($line) = @_; | |||
| 9 | 9 | 8 | chomp $line; | |||
| 10 | 9 | 10 | return ($line, '') if $line =~ /^#/; | |||
| 11 | 9 | 17 | return ($line, '') unless $line =~ /./; | |||
| 12 | 9 | 17 | my $regex_pattern = qr{^(.*?) in regex; marked by <-- HERE in m/(.*) <-- HERE.*$}; | |||
| 13 | 9 | 5 | my $warning; | |||
| 14 | local $SIG{__WARN__} = sub { | |||||
| 15 | 4 | 19 | $warning = $_[0]; | |||
| 16 | 9 | 25 | }; | |||
| 17 | 9 9 | 3 69 | if (eval {qr/$line/} && ($warning eq '')) { | |||
| 18 | 3 | 11 | return ($line, ''); | |||
| 19 | } | |||||
| 20 | 6 | 6 | $warning = $@ unless $warning; | |||
| 21 | 6 | 15 | $warning =~ s/(.*?)\n.*/$1/m; | |||
| 22 | 6 | 5 | my $err = $warning; | |||
| 23 | 6 | 2 | chomp $err; | |||
| 24 | 6 | 21 | $err =~ s{$regex_pattern}{$2}; | |||
| 25 | 6 | 6 | my $code = $1; | |||
| 26 | 6 | 9 | my $start = $+[2] - $-[2]; | |||
| 27 | 6 | 6 | my $end = $start + 1; | |||
| 28 | 6 | 5 | my $wrapped = CheckSpelling::Util::wrap_in_backticks($err); | |||
| 29 | 6 | 6 | if ($code =~ /(^Unmatched )(.)$/) { | |||
| 30 | 2 | 2 | $code = $1 . CheckSpelling::Util::wrap_in_backticks($2); | |||
| 31 | } | |||||
| 32 | 6 | 22 | return ("^\$\n", "$start ... $end, Warning - $code: $wrapped (bad-regex)\n"); | |||
| 33 | } | |||||
| 34 | ||||||
| 35 | 1; | |||||