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
  21 my %options = (
  22   "log" => undef,
  23   "patterns" => undef,
  24     );
  25
  26 my @patterns = ();
  27
  28 for my $arg (@ARGV) {
  29   if ($arg eq "-help") {
  30     &sexit(0);
  31   }
  32   if ($arg =~ /^([^=]+)=(.+)$/) {
  33     my ($what, $val) = ($1, $2);
  34     if (exists($options{$what})) {
  35       if (defined($options{$what})) {
  36         print "Value for \"$what\" already defined\n";
  37         &sexit(1);
  38       }
  39       $options{$what} = $val;
  40     }
  41     else {
  42       print "Unknown param \"$what\"\n";
  43       &sexit(1);
  44     }
  45   }
  46   else {
  47     print "Wrong param syntax for \"$arg\"\n";
  48     &sexit(1);
  49   }
  50 }
  51
  52 for my $k (keys %options) {
  53   if (! defined($options{$k})) {
  54     &sexit(1);
  55   }
  56   if (! -r $options{$k}) {
  57     print "File \"$options{$k}\" is not readable\n";
  58     &sexit(1);
  59   }
  60 }
  61
  62 # Read patterns
  63 &readPatterns($options{"patterns"});
  64 if (&processLogFile($options{"log"}) > 0) {
  65   print "Errors occured, exiting\n";
  66   exit(1);
  67 }
  68
  69 exit(0);
  70
  71 sub syntax()
  72 {
  73   print "Syntax:\n";
  74   print " $0";
  75   for my $k (keys %options) {
  76     print " $k=<filename>";
  77   }
  78   print "\n";
  79 }
  80
  81 sub sexit($)
  82 {
  83   my ($exval) = @_;
  84   &syntax();
  85   exit($exval);
  86 }
  87
  88 sub convertPattern($)
  89 {
  90   my ($pat) = @_;
  91   if ($pat eq "") {
  92     return("");
  93   }
  94   return $pat if ($pat =~ /^Comment:/);
  95   if ($pat =~ s/^Regex:\s+//) {
  96     # PassThrough variant
  97     return($pat);
  98   }
  99   elsif ($pat =~ s/^Simple:\s+//) {
 100     return convertSimplePattern($pat);
 101   }
 102   else {
 103     # This should not happen.
 104     return undef;
 105   }
 106 }
 107
 108 sub convertSimplePattern($)
 109 {
 110   # Convert all chars '[]()+'
 111   my ($pat) = @_;
 112   if ($pat eq "") {
 113     return("");
 114   }
 115   if ($pat =~ /^(.*)(\\n)(.*)$/) {
 116     # do not convert '\n'
 117     my ($first, $found, $third) = ($1, $2, $3);
 118     $first = &convertSimplePattern($first);
 119     $third = &convertSimplePattern($third);
 120     return("$first$found$third");
 121   }
 122   if ($pat =~ /^(.*)([\[\]\(\)\+\^\{\}\\])(.*)$/) {
 123     my ($first, $found, $third) = ($1, $2, $3);
 124     $first = &convertSimplePattern($first);
 125     $third = &convertSimplePattern($third);
 126     return($first . "\\$found" . $third);
 127   }
 128   # Substitue white spaces
 129   while ($pat =~ s/[\s]+/\\s\+/) {};
 130   return($pat);
 131 }
 132
 133 sub readPatterns($)
 134 {
 135   my ($patfile) = @_;
 136
 137   my $errors = 0;
 138   if (open(FP, $patfile)) {
 139     my $line = 0;
 140     while (my $p = <FP>) {
 141       $line++;
 142       chomp($p);
 143       $p = &convertPattern($p);
 144       if (defined($p)) {
 145         push(@patterns, $p) if ($p ne "");
 146       }
 147       else {
 148         print "Wrong entry in patterns-file at line $line\n";
 149         $errors++;
 150       }
 151     }
 152     close(FP);
 153   }
 154   if ($errors > 0) {
 155     exit(1);
 156   }
 157 }
 158
 159 sub processLogFile($)
 160 {
 161   my ($log) = @_;
 162   my $prevl = "\n";
 163
 164   my $found;
 165   my $errors = 1;
 166   my @savedlines = ();
 167   my $readsavedlines = 0;
 168   my $savedline;
 169   my $comment = "";
 170   if (open(FL, $log)) {
 171     $errors = 0;
 172     my $line = 0;
 173     for my $pat (@patterns) {
 174       if ($pat =~ /^Comment:\s*(.*)$/) {
 175         $comment = $1;
 176         $comment =~ s/\s+$//;
 177         if ($comment ne "") {
 178           print "............ $comment ..........\n";
 179         }
 180         next;
 181       }
 182       #print "Searching for \"$pat\"\n";
 183       $found = 0;
 184       my @lines = ();
 185       if ($readsavedlines) {
 186         # Last regex not found
 187         @lines = @savedlines;
 188         @savedlines = ();
 189         $line = $savedline;
 190       }
 191       else {
 192         $savedline = $line;
 193       }
 194       while (1) {
 195         my $l;
 196         if ($readsavedlines) {
 197           $l = shift(@lines);
 198         }
 199         else {
 200           $l = <FL>;
 201         }
 202         last if (! $l);
 203         my $check = $prevl . $l;
 204         $prevl = $l;
 205         $line++;
 206         if ($check =~ /$pat/) {
 207           print "$line:\tfound \"$pat\"\n";
 208           $found = 1;
 209           $prevl = "\n";        # Don't search this line again
 210           if ($readsavedlines) {
 211             @savedlines = @lines;
 212           }
 213           else {
 214             @savedlines = ();
 215           }
 216           $savedline = $line;
 217           last;
 218         }
 219         else {
 220           push(@savedlines, $l);
 221         }
 222       }
 223       if (! $found) {
 224         $errors++;
 225         print "\tNOT found \"$pat\" in remainder of file\n";
 226         $readsavedlines = 1;
 227       }
 228     }
 229     close(FL);
 230   }
 231   return($errors);
 232 }