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 %options = (
  23   "log" => undef,
  24   "patterns" => undef,
  25     );
  26
  27 my @patterns = ();
  28
  29 for my $arg (@ARGV) {
  30   if ($arg eq "-help") {
  31     &sexit(0);
  32   }
  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";
  38         &sexit(1);
  39       }
  40       $options{$what} = $val;
  41     }
  42     else {
  43       print "Unknown param \"$what\"\n";
  44       &sexit(1);
  45     }
  46   }
  47   else {
  48     print "Wrong param syntax for \"$arg\"\n";
  49     &sexit(1);
  50   }
  51 }
  52
  53 for my $k (keys %options) {
  54   if (! defined($options{$k})) {
  55     &sexit(1);
  56   }
  57   if (! -r $options{$k}) {
  58     print "File \"$options{$k}\" is not readable\n";
  59     &sexit(1);
  60   }
  61 }
  62
  63 # Read patterns
  64 &readPatterns($options{"patterns"});
  65 if (&processLogFile($options{"log"}) > 0) {
  66   print "Errors occured, exiting\n";
  67   exit(1);
  68 }
  69
  70 exit(0);
  71
  72 sub syntax()
  73 {
  74   print "Syntax:\n";
  75   print " $0";
  76   for my $k (keys %options) {
  77     print " $k=<filename>";
  78   }
  79   print "\n";
  80 }
  81
  82 sub sexit($)
  83 {
  84   my ($exval) = @_;
  85   &syntax();
  86   exit($exval);
  87 }
  88
  89 sub convertPattern($)
  90 {
  91   my ($pat) = @_;
  92   if ($pat eq "") {
  93     return("");
  94   }
  95   return $pat if ($pat =~ /^Comment:/);
  96   if ($pat =~ s/^((Err)?Regex):\s+//) {
  97     # PassThrough variant
  98     return($1 . ":" . $pat);
  99   }
 100   elsif ($pat =~ s/^((Err)?Simple):\s+//) {
 101     my $ermark = $2;
 102     $ermark = "" if (!defined($ermark));
 103     return $ermark . "Regex:" . &convertSimplePattern($pat);
 104   }
 105   else {
 106     # This should not happen.
 107     return undef;
 108   }
 109 }
 110
 111 sub convertSimplePattern($)
 112 {
 113   # Convert all chars '[]()+'
 114   my ($pat) = @_;
 115   if ($pat eq "") {
 116     return("");
 117   }
 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");
 124   }
 125   if ($pat =~ /^(.*)([\[\]\(\)\+\^\{\}\\])(.*)$/) {
 126     my ($first, $found, $third) = ($1, $2, $3);
 127     $first = &convertSimplePattern($first);
 128     $third = &convertSimplePattern($third);
 129     return($first . "\\$found" . $third);
 130   }
 131   # Substitue white spaces
 132   while ($pat =~ s/[\s]+/\\s\+/) {};
 133   return($pat);
 134 }
 135
 136 sub readPatterns($)
 137 {
 138   my ($patfile) = @_;
 139
 140   my $errors = 0;
 141   if (open(FP, $patfile)) {
 142     my $line = 0;
 143     while (my $p = <FP>) {
 144       $line++;
 145       chomp($p);
 146       $p = &convertPattern($p);
 147       if (defined($p)) {
 148         push(@patterns, $p) if ($p ne "");
 149       }
 150       else {
 151         print "Wrong entry in patterns-file at line $line\n";
 152         $errors++;
 153       }
 154     }
 155     close(FP);
 156   }
 157   if ($errors > 0) {
 158     exit(1);
 159   }
 160 }
 161
 162 sub processLogFile($)
 163 {
 164   my ($log) = @_;
 165   my $found;
 166   my $errors = 1;
 167   my @savedlines = ();
 168   my $readsavedlines = 0;
 169   my $savedline;
 170   my $comment = "";
 171   if (open(FL, $log)) {
 172     $errors = 0;
 173     my $line = 0;
 174     my @ErrPatterns = ();
 175     my $minprevlines = 0;
 176     for my $pat (@patterns) {
 177       if ($pat =~ /^Comment:\s*(.*)$/) {
 178         $comment = $1;
 179         $comment =~ s/\s+$//;
 180         if ($comment ne "") {
 181           print "............ $comment ..........\n";
 182         }
 183         next;
 184       }
 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);
 193           next;
 194         }
 195         else {
 196           # This is the pattern which we are looking for
 197           $pat = $regex;
 198         }
 199       }
 200       #print "Searching for \"$pat\"\n";
 201       $found = 0;
 202       my $invalidmessages = 0;
 203       my $prevlines = () = $pat =~ /\\n/g; # Number of lines in pattern
 204       $prevlines = $minprevlines if ($prevlines < $minprevlines);
 205       my @prevl = ();
 206       for (my $i = 0; $i <= $prevlines; $i++) {
 207         push(@prevl, "\n");
 208       }
 209       my @lines = ();
 210       if ($readsavedlines) {
 211         # Last regex not found
 212         @lines = @savedlines;
 213         @savedlines = ();
 214         $line = $savedline;
 215       }
 216       else {
 217         $savedline = $line;
 218       }
 219       while (1) {
 220         my $l;
 221         if ($readsavedlines) {
 222           $l = shift(@lines);
 223         }
 224         else {
 225           $l = <FL>;
 226         }
 227         last if (! $l);
 228         for (my $i = 0; $i < $prevlines; $i++) {
 229           $prevl[$i] = $prevl[$i+1];
 230         }
 231         $prevl[$prevlines] = $l;
 232         my $check = join("", @prevl);
 233         $line++;
 234         if ($check =~ /$pat/) {
 235           my $fline = $line - $prevlines;
 236           print "$fline:\tfound \"$pat\"\n";
 237           $found = 1;
 238           # Do not search in already found area
 239           for (my $i = 0; $i <= $prevlines; $i++) {
 240             $prevl[$i] = "\n";
 241           }
 242           if ($readsavedlines) {
 243             @savedlines = @lines;
 244           }
 245           else {
 246             @savedlines = ();
 247           }
 248           $savedline = $line;
 249           last;
 250         }
 251         else {
 252           push(@savedlines, $l);
 253           # Check for not wanted patterns
 254           for my $ep (@ErrPatterns) {
 255             if ($check =~ /$ep/) {
 256               $errors++;
 257               if ($invalidmessages++ < 10) {
 258                 my $fline = $line - $prevlines;
 259                 &printInvalid($fline, $check);
 260               }
 261               last;
 262             }
 263           }
 264         }
 265       }
 266       if (! $found) {
 267         $errors++;
 268         print "\tNOT found \"$pat\" in remainder of file\n";
 269         $readsavedlines = 1;
 270       }
 271       @ErrPatterns = ();        # clean search for not wanted patterns
 272       $minprevlines = 0;
 273     }
 274     close(FL);
 275   }
 276   return($errors);
 277 }
 278
 279 sub printInvalid($$)
 280 {
 281   my ($line, $check) = @_;
 282   my @chk = split(/\n/, $check);
 283   print("$line:\tInvalid match: " . shift(@chk) . "\n");
 284   for my $l (@chk) {
 285     print("\t\t\t$l\n");
 286   }
 287 }