#! /usr/bin/perl -w
# -*- perl -*-
# see cmpp.txt
#
# $Id: cmpp,v 1.1 1999/08/14 16:16:15 cm Exp $

require 'stat.pl';
use Getopt::Std;

$usage = "usage: $0 [options] inputfile ...
options:
	-M -- output dependency info, like gcc -M
	-i num -- max. include nesting
	-v num -- max. var expansion nesting
	-o dir -- dir to place output files in (inputfiles must be relative)\n";

# 	-I dir -- include path, like cc


#
# globals 
#
$max_inc_depth = 10;		# prevent loops on .include
$max_var_depth = 10;		# prevent loops in variable expansion

$inc_depth = $var_depth = 0;

$vars{"date"} = &format_date(time());

getopts("MI:i:v:o:") || die $usage;

$makedep = $opt_M; undef $opt_M; # make -w quiet
#unshift(@incpath, $opt_I) if $opt_i;
$max_inc_depth = $opt_i if $opt_i;
$max_var_depth = $opt_v if $opt_v;
$outdir = $opt_o ? "$opt_o/" : "";


# save away stdout
open(SAVEOUT, ">&STDOUT");

while($_ = shift) {
    $vars{"infile"} = $_;
    ($vars{"outfile"},$vars{"outlink"}) = &out_filename($_);
    $vars{"lastmod"} = &format_date((stat($_))[$ST_MTIME]);
    $makedep &&
	&add_dep($vars{"outfile"}, $vars{"infile"});
    &set_output($vars{"outfile"}, "top");
    &interpret(&get_file($_, "top"), $_);
}
open(STDOUT, ">&SAVEOUT");	# restore
close(SAVEOUT);

if($makedep) {
    foreach $of (sort keys %dependencies) {
	$dependencies{$of} =~ s/^\s+//;
	$dependencies{$of} =~ s/\s+/ \\\n /g; # wrap
	print "$of: $dependencies{$of}\n\n";
    }
}

exit;


# interprets string
sub interpret {
    local($in, $name) = @_;
    local(@tokens);

    @tokens = &parse($in, $name);
    foreach (@tokens) {
	if(! /^<</) {
	    print;
	} else {
	    s/\A<<//;
	    s/>>\Z//;
	    if(/^([\w\d_]+)=(.*)$/s) {
		local($var, $val) = split('=', $_, 2);
#		if($vars{$var}) {
#		    &bailout("interpret: redefined variable \"$var\" \@$name");
#		}
		$vars{$var} = $val;
	    } elsif(/^([\w\d_]+)$/) {
		if(defined $vars{$1}) {
		    #print $vars{$1};
		    if(++$var_depth > $max_var_depth) {
			&bailout("interpret: max var. expansion ".
				 "depth reached @$name {$1}");
		    }
    		    &interpret($vars{$1}, "$name {$1}");
		    $var_depth--;
		} else {
		    &bailout("interpret: uninitialized variable \"$1\" " .
			     "\@$name");
		}
	    } elsif(/^\.include\s+(.*)$/) {
		local($fn) = $1;
		if(++$inc_depth > $max_inc_depth) {
		    &bailout("interpret: include nesting too deep while " .
			     "including \"$fn\" from $name");
		}
		$makedep &&
		    &add_dep($vars{"outfile"}, $fn);
		local($inc_text) = &get_file($fn, $name);
		&interpret($inc_text, "$name < $fn");
		--$inc_depth;
	    } elsif(/^\.ref\s+(.*)$/) {
		local($fn) = $1;
		$makedep &&
		    &add_dep($vars{"outfile"}, $fn);
		&ref_file($fn, "$name -> $fn");
	    } elsif(/^\.condlink\s+(\S+)\s+(.*)$/s) {
		&cond_link($1, $2, $name);
	    } elsif(/^\.comm/) {
		# ignore...
	    } elsif(/^\.ifvar\s+([\w\d_]+)\s+(.*)$/s) {
		if($vars{$1}) {
		    &interpret($2, "$name .ifvar{$1}");
		}
	    } else {
		&bailout("interpret: unknown tag \"$_\" \@$name");
	    }
	}
    }
}


sub ref_file {
    local($fn, $name) = @_;

    $vars{"doctmpl"} ||
	&bailout("ref_file: no variable \"doctmpl\" @$name");
    $vars{"toctmpl"} ||
	&bailout("ref_file: no variable \"toctmpl\" @$name");

    local($rf) = &get_file($fn, $name);
    local($of,$ol) = &out_filename($fn);

    local(%old_vars) = %vars;	# save away to prevent duplicate var definition
    $vars{"lastmod"} = &format_date((stat($fn))[$ST_MTIME]);
    $vars{"reflink"} = $ol;

    &set_output("$fn.tmp", $name);
    &interpret($rf, $name);
    &set_output($of, $name);

    if(!$makedep) {
	$vars{"body"} = &get_file("$fn.tmp", $name);
	unlink("$fn.tmp");
    } else {
	$vars{"body"} = "";		# reqd later...
    }

    &interpret($vars{"doctmpl"}, $name);
    &set_output(">$old_vars{'outfile'}", $name);
    &interpret($vars{"toctmpl"}, $name);

    %vars = %old_vars;
}

sub cond_link {
    local($filename, $text, $name) = @_;

    if(($vars{"reflink"} && $vars{"reflink"} eq $filename) ||
       (!$vars{"reflink"} && $vars{"outlink"} eq $filename)) {
	print $text;
    } else {
	print "<A HREF=\"$filename\">$text</A>";
    }
}
    
# parse file
sub get_file {
    local($fn, $name) = @_;
    local(*F,$t);
    local($/) = undef;

    open(F, $fn) ||
	&bailout("get_file: open \"$fn\": $! \@$name");
    $t = <F>;
    close(F);
    $t;
}

    

# parses string for <<...>> delimiters, returns array of separated strings
# gets (string, name) where name is description of string for error msg
sub parse {
    local($in, $name) = @_;
    local($d, $t, @ret, @a) = (0, "");

    @a = split(/(<<|>>)/, $in);
    
    foreach(@a) {
	s/\s*\\\n//gm;
	next unless $_;
#	print "split: \"$_\"\n";
	if($_ eq "<<") {
	    $d++;
	    if($d > 1) {
		$t .= $_;
	    } else {
		push(@ret, $t) if $t;
		$t = $_;
	    }
	} elsif($_ eq ">>") {
	    if(--$d < 0) {
		&bailout("parse: too many >> \@$name");
	    }
	    if($d) {
		$t .= $_;
	    } else {
		push(@ret, "$t$_");
		$t = "";
	    }
	} else {
	    if($d == 0) {
		push(@ret, $_);
		$t = "";
	    } else {
		$t .= $_;
	    }
	}
    }
    if($d) {
	&bailout("parse: too many << \@$name");
    }
    @ret;
}

sub format_date {
    scalar(localtime($_[0]));
}

sub bailout {
    die(@_, "\n");
}

sub set_output {
    local($of) = ($makedep ? "/dev/null" : @_);
    close(STDOUT);		# is this implicit in open???
    open(STDOUT, ">$of") ||
	&bailout("set_output: open \">$of\": $! \@$_[1]");
}

sub add_dep {
    local($of, @deps) = @_;
    $dependencies{$of} .= " " . join(" ", @deps);
}

# generate out-(file,link) name from infile name
sub out_filename {
    local($f) = @_;
    $f =~ s/\.[^\.]+$/.html/;
    ("$outdir$f",$f);
}
    

#
# $Log: cmpp,v $
# Revision 1.1  1999/08/14 16:16:15  cm
# Initial revision
#
# Revision 1.2  1999/04/24 22:26:30  cm
# -M done right, some new options
#
# Revision 1.1  1999/04/24 21:08:52  cm
# Initial revision
#
#