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