4 # file searchPatterns.pl
5 # Uses patterns-file to consecutively process given tex-file
6 # Command succedes if each pattern matches the file content in given order
10 # searchPatterns.pl patterns=<name of file with patterns> log=<name of file to check against>
15 sub sexit($); # Print synax and exit
16 sub readPatterns($); # Process patterns file
17 sub processLogFile($); #
18 sub convertPattern($); # check for regex, comment
19 sub convertSimplePattern($); # escape some chars, (e.g. ']' ==> '\]')
20 sub printInvalid($$); # display lines which should not match
22 my ($logfile, $patternsfile, $basename, $newbase) = (undef, undef, undef);
25 "patterns" => \$patternsfile,
32 if ($arg eq "-help") {
35 if ($arg =~ /^([^=]+)=(.+)$/) {
36 my ($what, $val) = ($1, $2);
37 if (exists($options{$what})) {
38 if (defined(${$options{$what}})) {
39 print "Param \"$what\" already handled\n";
42 ${$options{$what}} = $val;
43 if ($what ne "base") {
45 if ($logfile =~ /^(.+)\.log[a-z]?\.txt$/) {
49 elsif ($what eq "patterns") {
50 if ($patternsfile =~ /^(.+)\.ctrl$/) {
55 print "Software error, unhandled param \"$what\"\n";
61 print "Unknown param \"$what\"\n";
66 print "Wrong param syntax for \"$arg\"\n";
71 $basename = $newbase if (! defined($basename));
72 if (defined($basename)) {
73 for my $k (keys %options) {
74 next if ($k eq "base");
75 if (! defined(${$options{$k}})) {
77 $logfile = $basename . ".loga.txt";
79 elsif ($k eq "patterns") {
80 $patternsfile = $basename . ".ctrl";
85 for my $k (keys %options) {
86 next if ($k eq "base");
87 if (! defined(${$options{$k}})) {
88 print "Param \"$k\" not defined\n";
91 if (! -r ${$options{$k}}) {
92 print "File \"${$options{$k}}\" is not readable\n";
98 print "\nControlfile\t= $patternsfile\n";
99 print "Log-file\t= $logfile\n\n";
100 &readPatterns($patternsfile);
101 if (&processLogFile($logfile) > 0) {
102 print "Errors occured, exiting\n";
112 for my $k (keys %options) {
113 my $type = "filename";
114 $type = "basename" if ($k eq "base");
115 print " \[$k=<$type>\]";
127 sub convertPattern($)
133 return $pat if ($pat =~ /^Comment:/);
134 if ($pat =~ s/^((Err)?Regex):\s+//) {
135 # PassThrough variant
136 return($1 . ":" . $pat);
138 elsif ($pat =~ s/^((Err)?Simple):\s+//) {
140 $ermark = "" if (!defined($ermark));
141 return $ermark . "Regex:" . &convertSimplePattern($pat);
144 # This should not happen.
149 sub convertSimplePattern($)
151 # Convert all chars '[]()+'
156 if ($pat =~ /^(.*)(\\n)(.*)$/) {
157 # do not convert '\n'
158 my ($first, $found, $third) = ($1, $2, $3);
159 $first = &convertSimplePattern($first);
160 $third = &convertSimplePattern($third);
161 return("$first$found$third");
163 if ($pat =~ /^(.*)([\[\]\(\)\+\^\{\}\\])(.*)$/) {
164 my ($first, $found, $third) = ($1, $2, $3);
165 $first = &convertSimplePattern($first);
166 $third = &convertSimplePattern($third);
167 return($first . "\\$found" . $third);
169 # Substitue white spaces
170 while ($pat =~ s/[\s]+/\\s\+/) {};
179 if (open(FP, $patfile)) {
181 while (my $p = <FP>) {
184 $p = &convertPattern($p);
186 push(@patterns, $p) if ($p ne "");
189 print "Wrong entry in patterns-file at line $line\n";
200 sub processLogFile($)
206 my $readsavedlines = 0;
209 if (open(FL, $log)) {
212 my @ErrPatterns = ();
213 my $minprevlines = 0;
214 for my $pat (@patterns) {
215 if ($pat =~ /^Comment:\s*(.*)$/) {
217 $comment =~ s/\s+$//;
218 if ($comment ne "") {
219 print "............ $comment ..........\n";
223 if ($pat =~ /^(Err)?Regex:(.*)$/) {
224 my ($type, $regex) = ($1, $2);
225 next if ($regex eq "");
226 if (defined($type)) {
227 # This regex should not apply until next 'found line'
228 my $erlines = () = $regex =~ /\\n/g;
229 $minprevlines = $erlines if ($erlines > $minprevlines);
230 push(@ErrPatterns, $regex);
234 # This is the pattern which we are looking for
238 #print "Searching for \"$pat\"\n";
240 my $invalidmessages = 0;
241 my $prevlines = () = $pat =~ /\\n/g; # Number of lines in pattern
242 $prevlines = $minprevlines if ($prevlines < $minprevlines);
244 for (my $i = 0; $i <= $prevlines; $i++) {
248 if ($readsavedlines) {
249 # Last regex not found
250 @lines = @savedlines;
259 if ($readsavedlines) {
266 for (my $i = 0; $i < $prevlines; $i++) {
267 $prevl[$i] = $prevl[$i+1];
269 $prevl[$prevlines] = $l;
270 my $check = join("", @prevl);
272 if ($check =~ /$pat/) {
273 my $fline = $line - $prevlines;
274 print "$fline:\tfound \"$pat\"\n";
276 # Do not search in already found area
277 for (my $i = 0; $i <= $prevlines; $i++) {
280 if ($readsavedlines) {
281 @savedlines = @lines;
290 push(@savedlines, $l);
291 # Check for not wanted patterns
292 for my $ep (@ErrPatterns) {
293 if ($check =~ /$ep/) {
295 if ($invalidmessages++ < 10) {
296 my $fline = $line - $prevlines;
297 &printInvalid($fline, $check);
306 print "\tNOT found \"$pat\" in remainder of file\n";
309 @ErrPatterns = (); # clean search for not wanted patterns
319 my ($line, $check) = @_;
320 my @chk = split(/\n/, $check);
321 print("$line:\tInvalid match: " . shift(@chk) . "\n");