| File: | check-pattern-file.pl |
| Coverage: | 84.4% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | #!/usr/bin/env perl | |||||
| 2 | ||||||
| 3 | 1 1 1 | 1035 1 458 | use CheckSpelling::CheckPattern; | |||
| 4 | ||||||
| 5 | 1 | 36374 | my $file = $ENV{file}; | |||
| 6 | 1 1 1 1 | 13 214 6 2 | open WARNINGS, ">>:encoding(UTF-8)", $ENV{early_warnings}; | |||
| 7 | 1 | 262 | $extension = '.orig'; | |||
| 8 | 1 | 17 | LINE: while (<>) { | |||
| 9 | 1 | 2 | if ($ARGV ne $oldargv) { | |||
| 10 | 1 | 3 | if ($extension !~ /\*/) { | |||
| 11 | 1 | 1 | $backup = $ARGV . $extension; | |||
| 12 | } | |||||
| 13 | else { | |||||
| 14 | 0 | 0 | ($backup = $extension) =~ s/\*/$ARGV/g; | |||
| 15 | } | |||||
| 16 | 1 | 20 | rename($ARGV, $backup); | |||
| 17 | 1 | 18 | open(ARGVOUT, ">$ARGV"); | |||
| 18 | 1 | 2 | select(ARGVOUT); | |||
| 19 | 1 | 1 | $oldargv = $ARGV; | |||
| 20 | } | |||||
| 21 | ||||||
| 22 | 1 | 2 | my ($line, $warning) = CheckSpelling::CheckPattern::process_line($_); | |||
| 23 | 1 | 5 | print "$line\n"; | |||
| 24 | 1 | 5 | if ($warning) { | |||
| 25 | 0 | 0 | print WARNINGS "$file:$.:$warning"; | |||
| 26 | } | |||||
| 27 | } | |||||
| 28 | 1 | 1 | select(STDOUT); | |||
| 29 | ||||||
| 30 | 1 | 0 | close(WARNINGS); | |||