| 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 | 112440 3 419 | use CheckSpelling::Util; | |||
| 6 | ||||||
| 7 | sub process_line { | |||||
| 8 | 9 | 3144 | my ($line) = @_; | |||
| 9 | 9 | 13 | chomp $line; | |||
| 10 | 9 | 15 | return ($line, '') if $line =~ /^#/; | |||
| 11 | 9 | 20 | return ($line, '') unless $line =~ /./; | |||
| 12 | 9 | 15 | my $regex_pattern = qr{^(.*?) in regex; marked by <-- HERE in m/(.*) <-- HERE.*$}; | |||
| 13 | 9 | 11 | my $warning; | |||
| 14 | local $SIG{__WARN__} = sub { | |||||
| 15 | 4 | 27 | $warning = $_[0]; | |||
| 16 | 9 | 32 | }; | |||
| 17 | 9 9 | 9 93 | if (eval {qr/$line/} && ($warning eq '')) { | |||
| 18 | 3 | 13 | return ($line, ''); | |||
| 19 | } | |||||
| 20 | 6 | 9 | $warning = $@ unless $warning; | |||
| 21 | 6 | 23 | $warning =~ s/(.*?)\n.*/$1/m; | |||
| 22 | 6 | 6 | my $err = $warning; | |||
| 23 | 6 | 6 | chomp $err; | |||
| 24 | 6 | 30 | $err =~ s{$regex_pattern}{$2}; | |||
| 25 | 6 | 9 | my $code = $1; | |||
| 26 | 6 | 10 | my $start = $+[2] - $-[2]; | |||
| 27 | 6 | 7 | my $end = $start + 1; | |||
| 28 | 6 | 10 | my $wrapped = CheckSpelling::Util::wrap_in_backticks($err); | |||
| 29 | 6 | 10 | if ($code =~ /(^Unmatched )(.)$/) { | |||
| 30 | 2 | 2 | $code = $1 . CheckSpelling::Util::wrap_in_backticks($2); | |||
| 31 | } | |||||
| 32 | 6 | 28 | return ("^\$\n", "$start ... $end, Warning - $code: $wrapped (bad-regex)\n"); | |||
| 33 | } | |||||
| 34 | ||||||
| 35 | 1; | |||||