development/autotests/searchPatterns.pl

   1 #! /usr/bin/env perl
   2 # -*- mode: perl; -*-
   3 #
   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
   7 #
   8 # How to use:
   9 #
  10 # searchPatterns.pl patterns=<name of file with patterns> log=<name of file to check against>
  11
  12 use strict;
  13 use warnings;
  14
  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
  21
  22 my ($logfile, $patternsfile, $basename, $newbase) = (undef, undef, undef);
  23 my %options = (
  24   "log" => \$logfile,
  25   "patterns" => \$patternsfile,
  26   "base" => \$basename,
  27     );
  28
  29 my @patterns = ();
  30
  31 for my $arg (@ARGV) {
  32   if ($arg eq "-help") {
  33     &sexit(0);
  34   }
  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";
  40         sexit(1);
  41       }
  42       ${$options{$what}} = $val;
  43       if ($what ne "base") {
  44         if ($what eq "log") {
  45           if ($logfile =~ /^(.+)\.log[a-z]?\.txt$/) {
  46             $newbase = $1;
  47           }
  48         }
  49         elsif ($what eq "patterns") {
  50           if ($patternsfile =~ /^(.+)\.ctrl$/) {
  51             $newbase = $1;
  52           }
  53         }
  54         else {
  55           print "Software error, unhandled param \"$what\"\n";
  56           &sexit(1);
  57         }
  58       }
  59     }
  60     else {
  61       print "Unknown param \"$what\"\n";
  62       &sexit(1);
  63     }
  64   }
  65   else {
  66     print "Wrong param syntax for \"$arg\"\n";
  67     &sexit(1);
  68   }
  69 }
  70
  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}})) {
  76       if ($k eq "log") {
  77         $logfile = $basename . ".loga.txt";
  78       }
  79       elsif ($k eq "patterns") {
  80         $patternsfile = $basename . ".ctrl";
  81       }
  82     }
  83   }
  84 }
  85 for my $k (keys %options) {
  86   next if ($k eq "base");
  87   if (! defined(${$options{$k}})) {
  88     print "Param \"$k\" not defined\n";
  89     &sexit(1);
  90   }
  91   if (! -r ${$options{$k}}) {
  92     print "File \"${$options{$k}}\" is not readable\n";
  93     &sexit(1);
  94   }
  95 }
  96
  97 # Read patterns
  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";
 103   exit(1);
 104 }
 105
 106 exit(0);
 107
 108 sub syntax()
 109 {
 110   print "Syntax:\n";
 111   print " $0";
 112   for my $k (keys %options) {
 113     my $type = "filename";
 114     $type = "basename" if ($k eq "base");
 115     print " \[$k=<$type>\]";
 116   }
 117   print "\n";
 118 }
 119
 120 sub sexit($)
 121 {
 122   my ($exval) = @_;
 123   &syntax();
 124   exit($exval);
 125 }
 126
 127 sub convertPattern($)
 128 {
 129   my ($pat) = @_;
 130   if ($pat eq "") {
 131     return("");
 132   }
 133   return $pat if ($pat =~ /^Comment:/);
 134   if ($pat =~ s/^((Err)?Regex):\s+//) {
 135     # PassThrough variant
 136     return($1 . ":" . $pat);
 137   }
 138   elsif ($pat =~ s/^((Err)?Simple):\s+//) {
 139     my $ermark = $2;
 140     $ermark = "" if (!defined($ermark));
 141     return $ermark . "Regex:" . &convertSimplePattern($pat);
 142   }
 143   else {
 144     # This should not happen.
 145     return undef;
 146   }
 147 }
 148
 149 sub convertSimplePattern($)
 150 {
 151   # Convert all chars '[]()+'
 152   my ($pat) = @_;
 153   if ($pat eq "") {
 154     return("");
 155   }
 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");
 162   }
 163   if ($pat =~ /^(.*)([\[\]\(\)\+\^\{\}\\])(.*)$/) {
 164     my ($first, $found, $third) = ($1, $2, $3);
 165     $first = &convertSimplePattern($first);
 166     $third = &convertSimplePattern($third);
 167     return($first . "\\$found" . $third);
 168   }
 169   # Substitue white spaces
 170   while ($pat =~ s/[\s]+/\\s\+/) {};
 171   return($pat);
 172 }
 173
 174 sub readPatterns($)
 175 {
 176   my ($patfile) = @_;
 177
 178   my $errors = 0;
 179   if (open(FP, $patfile)) {
 180     my $line = 0;
 181     while (my $p = <FP>) {
 182       $line++;
 183       chomp($p);
 184       $p = &convertPattern($p);
 185       if (defined($p)) {
 186         push(@patterns, $p) if ($p ne "");
 187       }
 188       else {
 189         print "Wrong entry in patterns-file at line $line\n";
 190         $errors++;
 191       }
 192     }
 193     close(FP);
 194   }
 195   if ($errors > 0) {
 196     exit(1);
 197   }
 198 }
 199
 200 sub processLogFile($)
 201 {
 202   my ($log) = @_;
 203   my $found;
 204   my $errors = 1;
 205   my @savedlines = ();
 206   my $readsavedlines = 0;
 207   my $savedline;
 208   my $comment = "";
 209   if (open(FL, $log)) {
 210     $errors = 0;
 211     my $line = 0;
 212     my @ErrPatterns = ();
 213     my $minprevlines = 0;
 214     for my $pat (@patterns) {
 215       if ($pat =~ /^Comment:\s*(.*)$/) {
 216         $comment = $1;
 217         $comment =~ s/\s+$//;
 218         if ($comment ne "") {
 219           print "............ $comment ..........\n";
 220         }
 221         next;
 222       }
 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);
 231           next;
 232         }
 233         else {
 234           # This is the pattern which we are looking for
 235           $pat = $regex;
 236         }
 237       }
 238       #print "Searching for \"$pat\"\n";
 239       $found = 0;
 240       my $invalidmessages = 0;
 241       my $prevlines = () = $pat =~ /\\n/g; # Number of lines in pattern
 242       $prevlines = $minprevlines if ($prevlines < $minprevlines);
 243       my @prevl = ();
 244       for (my $i = 0; $i <= $prevlines; $i++) {
 245         push(@prevl, "\n");
 246       }
 247       my @lines = ();
 248       if ($readsavedlines) {
 249         # Last regex not found
 250         @lines = @savedlines;
 251         @savedlines = ();
 252         $line = $savedline;
 253       }
 254       else {
 255         $savedline = $line;
 256       }
 257       while (1) {
 258         my $l;
 259         if ($readsavedlines) {
 260           $l = shift(@lines);
 261         }
 262         else {
 263           $l = <FL>;
 264         }
 265         last if (! $l);
 266         for (my $i = 0; $i < $prevlines; $i++) {
 267           $prevl[$i] = $prevl[$i+1];
 268         }
 269         $prevl[$prevlines] = $l;
 270         my $check = join("", @prevl);
 271         $line++;
 272         if ($check =~ /$pat/) {
 273           my $fline = $line - $prevlines;
 274           print "$fline:\tfound \"$pat\"\n";
 275           $found = 1;
 276           # Do not search in already found area
 277           for (my $i = 0; $i <= $prevlines; $i++) {
 278             $prevl[$i] = "\n";
 279           }
 280           if ($readsavedlines) {
 281             @savedlines = @lines;
 282           }
 283           else {
 284             @savedlines = ();
 285           }
 286           $savedline = $line;
 287           last;
 288         }
 289         else {
 290           push(@savedlines, $l);
 291           # Check for not wanted patterns
 292           for my $ep (@ErrPatterns) {
 293             if ($check =~ /$ep/) {
 294               $errors++;
 295               if ($invalidmessages++ < 10) {
 296                 my $fline = $line - $prevlines;
 297                 &printInvalid($fline, $check);
 298               }
 299               last;
 300             }
 301           }
 302         }
 303       }
 304       if (! $found) {
 305         $errors++;
 306         print "\tNOT found \"$pat\" in remainder of file\n";
 307         $readsavedlines = 1;
 308       }
 309       @ErrPatterns = ();        # clean search for not wanted patterns
 310       $minprevlines = 0;
 311     }
 312     close(FL);
 313   }
 314   return($errors);
 315 }
 316
 317 sub printInvalid($$)
 318 {
 319   my ($line, $check) = @_;
 320   my @chk = split(/\n/, $check);
 321   print("$line:\tInvalid match: " . shift(@chk) . "\n");
 322   for my $l (@chk) {
 323     print("\t\t\t$l\n");
 324   }
 325 }