5 # Copyright 2011 Jean Privat <jean@pryen.org>
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
11 # http://www.apache.org/licenses/LICENSE-2.0
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.
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.
30 my $usage = "Usage: alterner.pl [-d dir] [--start pat] [--end pat] file...";
32 print STDERR
$msg . "\n" . $usage . "\n";
42 while (@ARGV && !$stop) {
46 $directory = $val or usage
"$arg requires a directory.";
49 } elsif ($arg eq "--start") {
50 $start = $val or usage
"$arg requires a pattern.";
53 } elsif ($arg eq "--end") {
54 $end = $val or usage
"$arg requires a pattern.";
57 } elsif ($arg eq "--altsep") {
58 $altsep = $val or usage
"$arg requires a pattern.";
61 } elsif ($arg eq "-h" || $arg eq "--help") {
64 } elsif ($arg eq "--") {
67 } elsif ($arg =~ /^-/) {
68 usage
"Unknown argument $arg.";
75 usage("No input file.");
78 # Is $_[0] triggers the alternative directive $[1]?
79 sub triggers_alt($$) {
81 my $directive = shift;
82 foreach my $a (split
",", $directive) {
83 if ($a =~ /^(\d+)-(\d+)$/) {
84 if ($1 <= $number && $number <= $2) {
96 # Generate alternatives from the specified input-file using a specific altmark
97 sub process_alts($$) {
101 open
my $in, "<", $file or die
"$file: $!";
105 my $prefix = $start . $altmark;
107 # Collect alternatives
109 foreach my $l (@lines) {
110 while ($l =~ /\Q$prefix\E([\d,-]+)(\Q$start\E|\b)/g
) {
111 for my $a (split
/[,-]/, $1) {
116 my @alt = sort(keys(%alt));
119 # Process each alternatives
120 foreach my $alt (@alt) {
121 # Exctact the basename and the suffix
122 my ($name, $path, $suffix) = fileparse($file, qr
/\.[^\.]*/);
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: $!";
132 push
@files, $outfile;
134 # Write the alternative
135 open
my $out, ">", $outfile or die
"$outfile: $!";
137 foreach my $l (@lines) {
140 while ($l =~ /(\Q$prefix\E([\d,-]+)(\Q$start\E|\b))/g
) {
141 if (triggers_alt
$alt, $2) {
145 if ($selected && $l =~ /^(\s*)(.*)(\s*)(\Q$selected\E)([ \t]*)(.*)([ \t]*\Q$end\E\s*)$/) {
146 $l2 = "$1$6$3$4$5$2$7";
148 print $out $l2 or die
"$outfile: $!";
155 # Generate combination of alternatives from the specified input-file
156 sub process_xalts($) {
159 open
my $in, "<", $file or die
"$file: $!";
163 # Collect combination of alternatives
165 foreach my $l (@lines) {
166 while ($l =~ /\Q$start\E(\d*alt)\d+(\Q$start\E|\b)/g
) {
170 my @alt = sort(keys(%alt));
173 # Process each combination of alternatives
174 foreach my $alt (@alt) {
176 foreach my $f (@files) {
177 push
@newfiles, process_alts($f, $alt);
179 push
@files, @newfiles;
184 foreach my $file (@ARGV) {
185 process_xalts($file);