expand.pl

#!/usr/bin/perl

# Copyright (C) 2012 STRATO.  All rights reserved.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public
# License v2 as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public
# License along with this program; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 021110-1307, USA.

use strict;
use warnings;
use Getopt::Std;

sub permute ($@) {
	my $res = shift;
	my @idx = 0..$#_;
	while (1) {
		push @$res, [@_[@idx]];
		my $p = $#idx;
		--$p while $idx[$p-1] > $idx[$p];
		my $q = $p or return;
		push @idx, reverse splice @idx, $p;
		++$q while $idx[$p-1] > $idx[$q];
		@idx[$p-1,$q]=@idx[$q,$p-1];
	}
}

sub enum($$$$$);
sub output($$$);
sub enum($$$$$) {
	my ($fn, $lines, $names, $ix, $out) = @_;

	if ($ix == @$names) {
		output($fn, $lines, $out);
		return;
	}

	my $a = $names->[$ix];
	my ($n, $e) = @$a;
	my $res = [];
	permute($res, keys %$e);

	foreach my $r (@$res) {
		my %o;
		my $i = 0;
		foreach (@$r) {
			$o{$n}->{$_} = ++$i;
		}
		enum($fn, $lines, $names, $ix + 1, { %$out, %o});
	}
}

my $outdir;
my $cnt;
my %opts;
sub output($$$) {
	my ($fn, $lines, $out) = @_;
	my $repl = sub {
		my $r = shift;
		if ($r =~ /^(.*)\.(.*)$/) {
			return "$1.".$out->{$1}->{$2};
		} else {
			return $out->{"INO"}->{$1};
		}
	};

	$fn =~ m{(?:^|/)(\d+)-(.*).mac$};
	die "filename not of the form <digits>-<text>.mac" unless defined $2;
	print "writing $1:$cnt-$2.ac\n" if !$opts{q};
	my $path = "$outdir/$1:$cnt-$2.ac";
	open FH, ">$path" or die "failed to write $path: $!\n";
	foreach my $line (@$lines) {
		my $l = $line;
		$l =~ s/\$([\d\w.]+)/$repl->($1)/ge;
		print FH $l;
	}
	close FH;
	++$cnt;
}

my $all_ok = getopts("ho:q", \%opts);

if (!$all_ok || $opts{h} || !$opts{o} || !@ARGV) {
	print STDERR "usage: $0 [-q] -o outdir filename...\n";
	exit(!$opts{h});
}

$outdir = $opts{o};
mkdir($outdir);

foreach my $fn (@ARGV) {
	print "reading $fn\n" if !$opts{q};
	open FH, "<$fn" or die;
	my @lines;
	my %names;
	$cnt = "001";
	while(<FH>) {
		my $l;
		$l = $_;
		while($l =~ s/^[^\$]*\$([\d\w.]+)//) {
			my $var = $1;
			if ($var =~ /^(.*)\.(.*)$/) {
				$names{$1}->{$2} = 1;
			} else {
				$names{"INO"}->{$1} = 1;
			}
		}
		push @lines, $_;
	}
	close FH;

	my @names;
	foreach (keys %names) {
		push @names, [$_, $names{$_}];
	}

	enum($fn, \@lines, \@names, 0, {});
}