#!/usr/bin/perl


sub UsageShort() {
	print "Usage: tabfmt [ -h | --help ] | [ format.tab [variables1.var ... variablesN.var] ]\n" ;
}

sub UsageLong() {
	print "   Escapes in the format file are:\n" ;
	print "     _ \$(var_name)    : variable content is simply printed\n" ;
	print "     _ \${expression}  : the expression is evaluated\n" ;
	print "     An additionnal imperative size can be specified by using\n" ;
	print "       \$(var_name):size or \${expression}:size\n" ;
	print "   The variables file contains one variable definition by line:\n" ;
	print "     _ VAR = no_whitespace_string\n" ;
	print "     _ VAR = \"any words without double quotes\"\n" ;
	print "     A dash ('-') stands for the standard input\n" ;
}

if(scalar(@ARGV)==0) {
	UsageShort() ;
	exit 1 ;
}


if(($ARGV[0] eq '-h')||($ARGV[0] eq '--help')) {
	UsageShort() ;
	UsageLong() ;
	exit 0 ;
}


# FormatString
#   Formats a string, according to alignment, into a string of fixed length
#   Args:
#         _str             : string to format
#         _fil             : character filler
#         _len             : total final length
#         _aln             : c|r|l , horizontal alignment
#   Returns:
#         _the formatted string
sub FormatString($$$$) {
	my $str = shift ;
	my $fil = shift ;
	my $len = shift ;
	my $aln = shift ;
	if(length($fil)==0) { $fil = ' ' ; }
	$fil = substr($fil,0,1) ;	
	if(!defined $str) { return $fil x $len ; }
	if(length($str)>=$len) { return $str ; }
	if($aln eq 'l') { return $str . ($fil x ($len-length($str))) ; }
	elsif($aln eq 'r') { return ($fil x ($len-length($str))) . $str ; }
	elsif($aln eq 'c') {
		return ($fil x (($len-length($str))/2)) . $str . ($fil x (($len+1-length($str))/2)) ;
	}
	else { return $str ; }
}


# InterpretString
#   Parses and rewrite a variable or expression definition
#   Args:
#         _var             : reference to a variables hash
#         _str             : string to parse
#         _len             : length of result string [optional]
#   Returns:
#         _an interpreted string, if the hash ref was valid and '$(..)' or '${..}'
#            patterns were found
#         _a '*' (star) only string if the hash ref was invalid
#         _the original string otherwise
sub InterpretString($$;$) {
	my $var = shift ;
	my $str = shift ;
	my $len = length($str) ;
	my $alg = 'c' ;
	if(scalar(@_)) {
		my $tmp = shift ;
		if($tmp=~/^([rcl])(\d+)/) {
			$alg = $1 ;
			$len = $2 ;
		}
		else { $len = $tmp ; }
	}
	if(ref($var) ne 'HASH') { return '*' x $len ; }
	if($str=~m/^\s*\$\(([^\)]+)\)\s*$/) {
#print stderr "Format \"$str\"\n" ;
		return FormatString($var->{$1},' ',$len,$alg) ;
	}
	elsif($str=~m/^\s*\$\{([^\}]+)\}\s*$/) {
#print stderr "Interp \"$str\"\n" ;
		$str = $1 ;
		if($str =~ /\$/) {
			$str =~ s/\$\(([^\)]+)\)/$var->{$1}/g ;
			local $SIG{__WARN__} = sub { } ;
			$str = eval($str) ;
		}
		if(length($str)>$len) { $str = substr($str,0,$len) ; }
		return FormatString($str,' ',$len,$alg) ;
	}
#print stderr "Reject \"$str\"\n" ;
	return $str ;
}


# LoadVarFile
#   Loads a variables definition file into a hash
#   Args:
#         _var             : reference to a variables hash
#         _file            : the file to read
#   Returns:
#         _the original hash ref if it was defined and valid
#         _a ref to a new hash if the first argument was undef
#         _'undef' if the hash ref was invalid
sub LoadVarFile($$) {
	my $var = shift ;
	my $file = shift ;
	if(defined $var) {
		if(ref($var) ne 'HASH') { return undef ; }
	}
	else {
		$var = { } ;
	}
	if($file ne '-') {
		local *F ;
		open(F,'<',$file) ;
		while(<F>) {
			if(/^#/) { next ; }
			if(/^\s*$/) { next ; }
			if(
				   (/^\s*([^\s]+)\s*=\s*([^'"\s][^\s]*)/)
				|| (/^\s*([^\s]+)\s*=\s*"([^"]+)"/)
				|| (/^\s*([^\s]+)\s*=\s*'([^']+)'/)
			   ) {
				$var->{$1} = $2 ;
			}
		}
		close(F) ;
	}
	else {
		while(<stdin>) {
			if(/^#/) { next ; }
			if(/^\s*$/) { next ; }
			if(
				   (/^\s*([^\s]+)\s*=\s*([^'"\s][^\s]*)/)
				|| (/^\s*([^\s]+)\s*=\s*"([^"]+)"/)
				|| (/^\s*([^\s]+)\s*=\s*'([^']+)'/)
			   ) {
				$var->{$1} = $2 ;
			}
		}
	}
	return $var ;
}


my %allvars = ( '_processed_with_' => "$0" ) ;

sub PrintFile($) {
	my $file = shift ;
	if($file ne '-') {
		local *F ;
		open(F,'<',$file) ;
		while(<F>) {
			s/(?<=\|)(\s*\$(?:(?:\([^\)]+\))|(?:\{[^\}]+\}))\s*)(?=\|)/InterpretString(\%allvars,$1)/eg ;
			s/(?<=[^\s])\s*(\$(?:(?:\([^\)]+\))|(?:\{[^\}]+\}))):([rcl]?\d+)\s*(?=[^\s])/InterpretString(\%allvars,$1,$2)/eg ;
			s/(?<!\\)\\s/ /g ;
			print ;
		}
		close(F) ;
	}
	else {
		while(<F>) {
			s/(?<=\|)(\s*\$(?:(?:\([^\)]+\))|(?:\{[^\}]+\}))\s*)(?=\|)/InterpretString(\%allvars,$1)/eg ;
			s/(?<=[^\s])\s*(\$(?:(?:\([^\)]+\))|(?:\{[^\}]+\}))):([rcl]?\d+)\s*(?=[^\s])/InterpretString(\%allvars,$1,$2)/eg ;
			s/(?<!\\)\\s/ /g ;
			print ;
		}
	}
}

$fmt = shift @ARGV ;
for $var (@ARGV) {
	LoadVarFile(\%allvars,$var) ;
}

PrintFile($fmt) ;