tests/alterner.pl

   1 #!/usr/bin/perl
   2
   3 # Alterner.pl
   4 #
   5 # Copyright 2011 Jean Privat <jean@pryen.org>
   6 #
   7 # Licensed under the Apache License, Version 2.0 (the "License");
   8 # you may not use this file except in compliance with the License.
   9 # You may obtain a copy of the License at
  10 #
  11 #     http://www.apache.org/licenses/LICENSE-2.0
  12 #
  13 # Unless required by applicable law or agreed to in writing, software
  14 # distributed under the License is distributed on an "AS IS" BASIS,
  15 # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  16 # See the License for the specific language governing permissions and
  17 # limitations under the License.
  18
  19 use strict;
  20 use File::Basename;
  21
  22 # Default values for options
  23 my $directory = "alt"; # The directory where alternatives will be generated.
  24 my $start = "//"; # The marker at the begin of a directive (usually the start of a comment).
  25 my $end = ""; # The marker at the end of the line (usually the end of a comment)
  26 my $altsep = "."; # The separator used in generated file between the basename and the altmark.
  27
  28 sub usage(;$) {
  29         my $msg = shift;
  30         my $usage = "Usage: alterner.pl [-d dir] [--start pat] [--end pat] file...";
  31         if (defined $msg) {
  32                 print STDERR $msg . "\n" . $usage . "\n";
  33                 exit 1;
  34         } else {
  35                 print $usage . "\n";
  36                 exit 0;
  37         }
  38 }
  39
  40 # Process arguments.
  41 my $stop = 0;
  42 while (@ARGV && !$stop) {
  43         my $arg = $ARGV[0];
  44         my $val = $ARGV[1];
  45         if ($arg eq "-d") {
  46                 $directory = $val or usage "$arg requires a directory.";
  47                 shift @ARGV;
  48                 shift @ARGV;
  49         } elsif ($arg eq "--start") {
  50                 $start = $val or usage "$arg requires a pattern.";
  51                 shift @ARGV;
  52                 shift @ARGV;
  53         } elsif ($arg eq "--end") {
  54                 $end = $val or usage "$arg requires a pattern.";
  55                 shift @ARGV;
  56                 shift @ARGV;
  57         } elsif ($arg eq "--altsep") {
  58                 $altsep = $val or usage "$arg requires a pattern.";
  59                 shift @ARGV;
  60                 shift @ARGV;
  61         } elsif ($arg eq "-h" || $arg eq "--help") {
  62                 shift @ARGV;
  63                 usage
  64         } elsif ($arg eq "--") {
  65                 shift @ARGV;
  66                 $stop = 1;
  67         } elsif ($arg =~ /^-/) {
  68                 usage "Unknown argument $arg.";
  69         } else {
  70                 $stop = 1;
  71         }
  72 }
  73
  74 if ($#ARGV == -1) {
  75         usage("No input file.");
  76 }
  77
  78 # Is $_[0] triggers the alternative directive $[1]?
  79 sub triggers_alt($$) {
  80         my $number = shift;
  81         my $directive = shift;
  82         foreach my $a (split ",", $directive) {
  83                 if ($a =~ /^(\d+)-(\d+)$/) {
  84                         if ($1 <= $number && $number <= $2) {
  85                                 return 1;
  86                         }
  87                 } else {
  88                         if ($number == $a) {
  89                                 return 1;
  90                         }
  91                 }
  92         }
  93         return 0;
  94 }
  95
  96 # Generate alternatives from the specified input-file using a specific altmark
  97 sub process_alts($$) {
  98         my $file = shift;
  99         my $altmark = shift;
 100         # Read the file
 101         open my $in, "<", $file or die "$file: $!";
 102         my @lines = <$in>;
 103         close($file);
 104
 105         my $prefix = $start . $altmark;
 106
 107         # Collect alternatives
 108         my %alt;
 109         foreach my $l (@lines) {
 110                 while ($l =~ /\Q$prefix\E([\d,-]+)(\Q$start\E|\b)/g) {
 111                         for my $a (split /[,-]/, $1) {
 112                                 $alt{$a} = 1;
 113                         }
 114                 }
 115         }
 116         my @alt = sort(keys(%alt));
 117
 118         my @files;
 119         # Process each alternatives
 120         foreach my $alt (@alt) {
 121                 # Exctact the basename and the suffix
 122                 my ($name, $path, $suffix) = fileparse($file, qr/\.[^\.]*/);
 123
 124                 # Compute filename of the alternative
 125                 my $outfile = $name . $altsep . $altmark . $alt . $suffix;
 126                 if (defined $directory && $directory ne ".") {
 127                         $outfile = $directory . "/" . $outfile;
 128                         if (! -d $directory) {
 129                                 mkdir $directory or die "$directory: $!";
 130                         }
 131                 }
 132                 push @files, $outfile;
 133
 134                 # Write the alternative
 135                 open my $out, ">", $outfile or die "$outfile: $!";
 136                 print "$outfile\n";
 137                 foreach my $l (@lines) {
 138                         my $l2 = $l;
 139                         my $selected;
 140                         while ($l =~ /(\Q$prefix\E([\d,-]+)(\Q$start\E|\b))/g) {
 141                                 if (triggers_alt $alt, $2) {
 142                                         $selected = $1;
 143                                 }
 144                         }
 145                         if ($selected && $l =~ /^(\s*)(.*)(\s*)(\Q$selected\E)([ \t]*)(.*)([ \t]*\Q$end\E\s*)$/) {
 146                                 $l2 = "$1$6$3$4$5$2$7";
 147                         }
 148                         print $out $l2 or die "$outfile: $!";
 149                 }
 150                 close $out;
 151         }
 152         return @files;
 153 }
 154
 155 # Generate combination of alternatives from the specified input-file
 156 sub process_xalts($) {
 157         my $file = shift;
 158         # Read the file
 159         open my $in, "<", $file or die "$file: $!";
 160         my @lines = <$in>;
 161         close($file);
 162
 163         # Collect combination of alternatives
 164         my %alt;
 165         foreach my $l (@lines) {
 166                 while ($l =~ /\Q$start\E(\d*alt)\d+(\Q$start\E|\b)/g) {
 167                         $alt{$1} = $1;
 168                 }
 169         }
 170         my @alt = sort(keys(%alt));
 171
 172         my @files = $file;
 173         # Process each combination of alternatives
 174         foreach my $alt (@alt) {
 175                 my @newfiles;
 176                 foreach my $f (@files) {
 177                         push @newfiles, process_alts($f, $alt);
 178                 }
 179                 push @files, @newfiles;
 180         }
 181 }
 182
 183 # Do the job
 184 foreach my $file (@ARGV) {
 185         process_xalts($file);
 186 }