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 $found;
 163   my $errors = 1;
 164   my @savedlines = ();
 165   my $readsavedlines = 0;
 166   my $savedline;
 167   my $comment = "";
 168   if (open(FL, $log)) {
 169     $errors = 0;
 170     my $line = 0;
 171     for my $pat (@patterns) {
 172       if ($pat =~ /^Comment:\s*(.*)$/) {
 173         $comment = $1;
 174         $comment =~ s/\s+$//;
 175         if ($comment ne "") {
 176           print "............ $comment ..........\n";
 177         }
 178         next;
 179       }
 180       #print "Searching for \"$pat\"\n";
 181       $found = 0;
 182       my $prevlines = () = $pat =~ /\\n/g; # Number of lines in pattern
 183       my @prevl = ();
 184       for (my $i = 0; $i <= $prevlines; $i++) {
 185         push(@prevl, "\n");
 186       }
 187       my @lines = ();
 188       if ($readsavedlines) {
 189         # Last regex not found
 190         @lines = @savedlines;
 191         @savedlines = ();
 192         $line = $savedline;
 193       }
 194       else {
 195         $savedline = $line;
 196       }
 197       while (1) {
 198         my $l;
 199         if ($readsavedlines) {
 200           $l = shift(@lines);
 201         }
 202         else {
 203           $l = <FL>;
 204         }
 205         last if (! $l);
 206         for (my $i = 0; $i < $prevlines; $i++) {
 207           $prevl[$i] = $prevl[$i+1];
 208         }
 209         $prevl[$prevlines] = $l;
 210         my $check = join("", @prevl);
 211         $line++;
 212         if ($check =~ /$pat/) {
 213           my $fline = $line - $prevlines;
 214           print "$fline:\tfound \"$pat\"\n";
 215           $found = 1;
 216           # Do not search in already found area
 217           for (my $i = 0; $i <= $prevlines; $i++) {
 218             $prevl[$i] = "\n";
 219           }
 220           if ($readsavedlines) {
 221             @savedlines = @lines;
 222           }
 223           else {
 224             @savedlines = ();
 225           }
 226           $savedline = $line;
 227           last;
 228         }
 229         else {
 230           push(@savedlines, $l);
 231         }
 232       }
 233       if (! $found) {
 234         $errors++;
 235         print "\tNOT found \"$pat\" in remainder of file\n";
 236         $readsavedlines = 1;
 237       }
 238     }
 239     close(FL);
 240   }
 241   return($errors);
 242 }