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