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 $prevlines = () = $pat =~ /\\n/g; # Number of lines in pattern
 203       $prevlines = $minprevlines if ($prevlines < $minprevlines);
 204       my @prevl = ();
 205       for (my $i = 0; $i <= $prevlines; $i++) {
 206         push(@prevl, "\n");
 207       }
 208       my @lines = ();
 209       if ($readsavedlines) {
 210         # Last regex not found
 211         @lines = @savedlines;
 212         @savedlines = ();
 213         $line = $savedline;
 214       }
 215       else {
 216         $savedline = $line;
 217       }
 218       while (1) {
 219         my $l;
 220         if ($readsavedlines) {
 221           $l = shift(@lines);
 222         }
 223         else {
 224           $l = <FL>;
 225         }
 226         last if (! $l);
 227         for (my $i = 0; $i < $prevlines; $i++) {
 228           $prevl[$i] = $prevl[$i+1];
 229         }
 230         $prevl[$prevlines] = $l;
 231         my $check = join("", @prevl);
 232         $line++;
 233         if ($check =~ /$pat/) {
 234           @ErrPatterns = ();    # clean search for not wanted patterns
 235           $minprevlines = 0;
 236           my $fline = $line - $prevlines;
 237           print "$fline:\tfound \"$pat\"\n";
 238           $found = 1;
 239           # Do not search in already found area
 240           for (my $i = 0; $i <= $prevlines; $i++) {
 241             $prevl[$i] = "\n";
 242           }
 243           if ($readsavedlines) {
 244             @savedlines = @lines;
 245           }
 246           else {
 247             @savedlines = ();
 248           }
 249           $savedline = $line;
 250           last;
 251         }
 252         else {
 253           push(@savedlines, $l);
 254           # Check for not wanted patterns
 255           my $errindex = 0;
 256           for my $ep (@ErrPatterns) {
 257             if ($check =~ /$ep/) {
 258               $errors++;
 259               my $fline = $line - $prevlines;
 260               printInvalid($fline, $check);
 261               #splice(@ErrPatterns, $errindex, 1);
 262               last;
 263             }
 264             $errindex++;
 265           }
 266         }
 267       }
 268       if (! $found) {
 269         $errors++;
 270         print "\tNOT found \"$pat\" in remainder of file\n";
 271         $readsavedlines = 1;
 272       }
 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 }