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
30 if ($arg eq "-help") {
33 if ($arg =~ /^([^=]+)=(.+)$/) {
34 my ($what, $val) = ($1, $2);
35 if (exists($options{$what})) {
36 if (defined($options{$what})) {
37 print "Value for \"$what\" already defined\n";
40 $options{$what} = $val;
43 print "Unknown param \"$what\"\n";
48 print "Wrong param syntax for \"$arg\"\n";
53 for my $k (keys %options) {
54 if (! defined($options{$k})) {
57 if (! -r $options{$k}) {
58 print "File \"$options{$k}\" is not readable\n";
64 &readPatterns($options{"patterns"});
65 if (&processLogFile($options{"log"}) > 0) {
66 print "Errors occured, exiting\n";
76 for my $k (keys %options) {
77 print " $k=<filename>";
95 return $pat if ($pat =~ /^Comment:/);
96 if ($pat =~ s/^((Err)?Regex):\s+//) {
98 return($1 . ":" . $pat);
100 elsif ($pat =~ s/^((Err)?Simple):\s+//) {
102 $ermark = "" if (!defined($ermark));
103 return $ermark . "Regex:" . &convertSimplePattern($pat);
106 # This should not happen.
111 sub convertSimplePattern($)
113 # Convert all chars '[]()+'
118 if ($pat =~ /^(.*)(\\n)(.*)$/) {
119 # do not convert '\n'
120 my ($first, $found, $third) = ($1, $2, $3);
121 $first = &convertSimplePattern($first);
122 $third = &convertSimplePattern($third);
123 return("$first$found$third");
125 if ($pat =~ /^(.*)([\[\]\(\)\+\^\{\}\\])(.*)$/) {
126 my ($first, $found, $third) = ($1, $2, $3);
127 $first = &convertSimplePattern($first);
128 $third = &convertSimplePattern($third);
129 return($first . "\\$found" . $third);
131 # Substitue white spaces
132 while ($pat =~ s/[\s]+/\\s\+/) {};
141 if (open(FP, $patfile)) {
143 while (my $p = <FP>) {
146 $p = &convertPattern($p);
148 push(@patterns, $p) if ($p ne "");
151 print "Wrong entry in patterns-file at line $line\n";
162 sub processLogFile($)
168 my $readsavedlines = 0;
171 if (open(FL, $log)) {
174 my @ErrPatterns = ();
175 my $minprevlines = 0;
176 for my $pat (@patterns) {
177 if ($pat =~ /^Comment:\s*(.*)$/) {
179 $comment =~ s/\s+$//;
180 if ($comment ne "") {
181 print "............ $comment ..........\n";
185 if ($pat =~ /^(Err)?Regex:(.*)$/) {
186 my ($type, $regex) = ($1, $2);
187 next if ($regex eq "");
188 if (defined($type)) {
189 # This regex should not apply until next 'found line'
190 my $erlines = () = $regex =~ /\\n/g;
191 $minprevlines = $erlines if ($erlines > $minprevlines);
192 push(@ErrPatterns, $regex);
196 # This is the pattern which we are looking for
200 #print "Searching for \"$pat\"\n";
202 my $prevlines = () = $pat =~ /\\n/g; # Number of lines in pattern
203 $prevlines = $minprevlines if ($prevlines < $minprevlines);
205 for (my $i = 0; $i <= $prevlines; $i++) {
209 if ($readsavedlines) {
210 # Last regex not found
211 @lines = @savedlines;
220 if ($readsavedlines) {
227 for (my $i = 0; $i < $prevlines; $i++) {
228 $prevl[$i] = $prevl[$i+1];
230 $prevl[$prevlines] = $l;
231 my $check = join("", @prevl);
233 if ($check =~ /$pat/) {
234 @ErrPatterns = (); # clean search for not wanted patterns
236 my $fline = $line - $prevlines;
237 print "$fline:\tfound \"$pat\"\n";
239 # Do not search in already found area
240 for (my $i = 0; $i <= $prevlines; $i++) {
243 if ($readsavedlines) {
244 @savedlines = @lines;
253 push(@savedlines, $l);
254 # Check for not wanted patterns
256 for my $ep (@ErrPatterns) {
257 if ($check =~ /$ep/) {
259 my $fline = $line - $prevlines;
260 printInvalid($fline, $check);
261 #splice(@ErrPatterns, $errindex, 1);
270 print "\tNOT found \"$pat\" in remainder of file\n";
281 my ($line, $check) = @_;
282 my @chk = split(/\n/, $check);
283 print("$line:\tInvalid match: " . shift(@chk) . "\n");