#! @PERL@
# ====================================================================
# Copyright (c) 2001, MeepZor Consulting.
# All rights reserved.
#
# The use and distribution of this code or document is
# governed by version 1.0.1 of the MeepZor Consulting Public
# Licence (MCPL), which may be found on the Internet at
# <URL:http://MeepZor.Com/>.
#

#
# $Id: mklicence.in,v 1.1 2001/05/15 18:03:46 coar Exp $
# Version: @PACKAGE_VERSION@
#

#
# When invoked from the shell, this script has two required options:
#
#    mklicence -f format [-l file] [-h] [-v] [-d] [-s] [-u undefined-string] \
#         [name:value ...]
#
# The rendered text is sent to STDOUT.
#
# -l file
#    Licence input file, containing text and definitions.  STDIN
#    is used if omitted or is '-'.
#
# -f format
#    Format of the output (sent to STDOUT).  Possible values are:
#
#    html
#     Each line is emitted as an HTML comment, with sentinel lines
#     at the beginning and end of the block.
#
#    text, txt
#     The edited text is simply emitted without any special formatting.
#
#    c, cblock, c-block
#     The entire text is emitted as a single C block comment.
#
#    cline, c-line
#     Each line is a standalone C comment, with sentinel lines at the
#     very beginning and very end of the output.
#
#    c++, cxx
#     Each line is a standalone C++ '//' comment.
#
#    man
#     Each line is a '.\"' comment.
#
#    perl, pl
#     Each line is a Perl line comment beginning with "#".
#
#    Other output languages can be added by simply updating the if-elsif
#    chain and adding a new handler routine.
#
# -d
#    Enables rudimentary debugging, and the .dump directive.
#
# -h
#    Displays the version and usage information.
#
# -s
#    Names defined by the command line cannot be overridden by definitions
#    in the file.
#
# -u undefined-string
#    Text string to substitute for undefined references.  Default is "".
#
# -v
#    Displays the version and usage information.
#

#
# Format of the input file:
#
# Special processing is signalled by the input line beginning with a
# dot (".").  This indicates that the line is a definition or a directive.
#
# Lines of the form ".name:value" define the specified name with the
# indicated value.  Predefined names are "Format" and "LicenceFile",
# and come from the mklicence command line.  They may be redefined
# by the input file.
#
# Defined names are substituted in subsequent lines (including
# directives) using the syntax ${name}.  The most recent definition
# of a name replaces any existing one, regardless of its origin.
# Substitution does *not* occur within definition names, only values.
# E.g., ".a${foo}b:value" does not have the value of 'foo' inserted.
# If a reference is made to an undefined name, the substitution
# text will be that specified by the -u command line option.
#
# .if/.else/.endif structures are supported, but not .elseif.
# The expression on a .if line is evaluated as a Perl expression;
# if the result of the evaluation is true, the enclosed lines are
# processed; otherwise they're ignored.  For instance,
#
#    .if "${Format}" =~ /text/i
#
# would evaluate as true IFF the output format was specified as
# plaintext on the command line.
#
# .if/.else/endif structures may be nested.
#
# Lines beginning with ".#" are considered comments and are discarded.
#
# The ".dump" directive, if enabled with the -d option and found in a
# section of active input (i.e., that's not being ignored due to conditional
# processing), dispays the current name-value pair table on STDERR.
#
# A '.literal' directive turns off *all* interpretation until a
# corresponding '.endliteral' directive is encountered.
#

use Getopt::Long;
use File::Basename;

#
# Preload some of our cells.
#
%keywords = ();                     # Keywords defined in the input
%ckeywords = ();                    # Keywords defined on the command line
$editfunc = 0;                      # Reference to transformation function
%arg = ();                          # Command-line arguments
$inputfile = "-";
$depth = -1;
$margin = 65;
$output_line = 1;
$fill = 0;
$0 = basename($0);

%formats = ('HTML'			=> \&make_html,
            'man'			=> \&make_man,
            'C-block|cblock|c'		=> \&make_c_block,
            'C-line|cline'		=> \&make_c_line,
            'Perl|pl'			=> \&make_perl,
            'text|txt|plain|plaintext'	=> \&make_text,
            'C\+\+|cxx'			=> \&make_cxx);
#
# Let's find out about our command arguments.
#
$got_options = GetOptions("format|f=s"		  => \$format_exact,
                          "debug|d!"		  => \$DEBUG,
                          "fill!"		  => \$fill,
                          "help|h"		  => \$help,
                          "margin=i"		  => \$margin,
                          "supersede|s!"	  => \$no_override,
                          "l=s"			  => \$inputfile,
                          "undefined-default|u=s" => \$undefined_message,
                          "version|v"             => \$show_version);

if ($DEBUG) {
    $ckeywords{'DEBUG'} = 1;
    &set_keyword('DEBUG', $ckeywords{'DEBUG'});
}
if ($show_version || $help ) {
    if ($show_version) {
        &show_version();
    }
    elsif ($help) {
        &usage();
    }
    exit(0);
}

if (! $format_exact) {
    printf STDERR ("$0: required option -f missing\n");
    exit 1;
}
elsif (($inputfile ne "-") && (! -f $inputfile)) {
    printf STDERR ("$0: can't access input file '$inputfile'\n");
    exit 1;
}

    printf STDERR ("mklicence version @PACKAGE_VERSION@\n");
#
# Select the appropriate transformer.  Here's where additional formats
# may be added.  Don't forget to include the corresponding handler
# function at the end of this file!
#
if (! &set_format($format_exact, 1)) {
    printf STDERR ("$0: invalid value for -f\n");
    exit 1;
}
push_format(0, $format_exact);

#
# Obtain the default substitution text if specified.
#
$undefined = $undefined_message || "";

#
# Preload a couple of values for use by the input file.  Pretend they
# were added on the command line so the lock flag can apply to them.
#
&set_keyword('DEPTH', $depth);
$ckeywords{'DEPTH'} = $depth;
&set_keyword('MARGIN', $margin);
$ckeywords{'MARGIN'} = $;
&set_keyword('FILL', $fill);
$ckeywords{'FILL'} = $;
&set_keyword('FORMAT', $format_general);
$ckeywords{'FORMAT'} = $format_general;
&set_keyword('FORMAT_EXACT', $format_exact);
$ckeywords{'FORMAT_EXACT'} = $format_exact;
$VERSION = join(".", q{$Id: mklicence.in,v 1.1 2001/05/15 18:03:46 coar Exp $} =~ m:\s(\d+\.\d+)\s:);
&set_keyword('VERSION', $VERSION);
$ckeywords{'VERSION'} = $keywords{'VERSION'};
&set_keyword('INPUTFILE', $inputfile);
$ckeywords{'INPUTFILE'} = $inputfile;

#
# Define any names from the command line.
#
foreach (@ARGV) {
    my($name, @value) = split(/:/, $_);

    &set_keyword($name, &substitute_keywords(join(':', @value), $undefined,
					     %keywords));
    $ckeywords{$name} = $keywords{$name};
}

#
# Now is the time for us to actually process the input.
#
@ifstart = ();                      # .if line numbers
@ifstate = ();                      # State of echoing at each level
$iflevel = 0;                       # Depth of .if nesting
$echo = 1;                          # Whether lines should be processed
$outerecho = 1;                     # Setting of $echo at the last .if level
$line = 1;                          # Current line of the file (for errors)
@output = ();                       # Output accumulator

#
# Step through all the input we got from the template file, processing
# directives as we come to them.
#
$literal = 0;
$echo = 1;

@output = &process_file($inputfile);
#
# We've gone through all the lines; see if we've returned to state 0
# in our conditional processing.  If not, complain about each of the
# .ifs for which we didn't see a corresponding .endif.
#
if ($#ifstart >= 0) {
    foreach (@ifstart) {
	print STDERR ("$0: .if at $_ has no corresponding .endif\n");
    }
}

#
# Figure out what the length is of the longest (edited) line.
# Note that we *don't* include the newline.
#
$longest = 0;
foreach (@output) {
    my($length);
    my($line) = $_;

    chomp($line);
    $length = length($line);
    if ((length($line) > $longest) && ($line !~ m/^\.[^: ]/)) {
	$longest = $length;
    }
}

#
# Initialise the transformation routine, and emit any text it generates.
#

$text = $editfunc->("BEGIN", $longest);
print $text if ($text);

#
# Dump the output as transformed and saved.
#
($next_xform, $next_format) = &pop_format();
$line = 0;
foreach (@output) {
    $line++;
    if ($line >= $next_xform) {
        &set_format($next_format, 1);
        ($next_xform, $next_format) = &pop_format();
    }
    print $editfunc->($_, $longest);
}

#
# Now do any trailer/cleanup handling.
#
$text = $editfunc->("END", $longest);
print $text if ($text);

#
# Cool!  We're done!
exit 0;

sub push_format {
    my($line, $format) = @_;

    push(@format_stack, "$line,$format");
    return 1;
}

sub pop_format {
    return split(m:,:, shift(@format_stack));
}

#
# Substitute any already-defined keywords..
#
sub substitute_keywords {
    my($input, $undefined, %keywords) = @_;
    my($kw, $value);
    local($output);

    $output = $input;
    for $kw (sort(keys(%keywords))) {
	$value = $keywords{$kw};
	$output =~ s:\${$kw}:$value:g;
    }
    #
    # Replace any leftover undefined references with a default string.
    #
    $output =~ s/\${[^: ]*}/$undefined/g;
    #
    # Heh.  Turn any embedded special characters into the real things.
    #
    $output =~ s:":\\":gs;
    eval("\$output = \"$output\"");
    return $output;
}

#
# Define a keyword in the global hash.
#
# We assume the globals $no_override, %keywords, and %ckeywords.
#
sub set_keyword {
    my($key, $value) = @_;
    my($ignored);

    $ignored = ($no_override && defined($ckeywords{$key}));

    if ($ignored) {
	if ($DEBUG) {
	    print STDERR ("$0: ignored attempt to redefine locked value "
                          . "for '$key'\n");
	}
	return 0;
    }
    if ($DEBUG) {
	print STDERR ("$0: keyword '$key' ");
	print STDERR (($keywords{$key}) ? "redefined" : "defined");
	print STDERR (" to '$value'\n");
    }
    $keywords{$key} = $value;
    return 1;
}

#
# Format to select the correct format..
#
sub set_format {
    my($fmt, $set) = @_;
    my($k, $f, $gfmt, $efmt, @kw, %result) = ();

    #
    # Reset the keywords hash
    #
    @kw = keys(%formats);
    while (($k, $f) = each(%formats)) {
        if ($fmt =~ m/^(?:$k)$/i) {
            ($gfmt) = split(m:\|:, $k);
            $gfmt = "\$gfmt = qq($gfmt)";
            eval($gfmt);
            $result{'editfunc'} = $f;
            $result{'format_general'} = $gfmt;
            $result{'format_exact'} = $fmt;
            last;
        }
    }
    if (! $gfmt) {
        return ();
    }
    if ($set) {
        $editfunc = $result{'editfunc'};
        $format_general = $result{'format_general'};
        $format_exact = $result{'format_exact'};
    }
    &set_keyword('FORMAT', $result{'format_general'});
    return %result;
}

#
# Function to read & process an input file.  The filename is the only
# argument.  Returns an array of output lines.
#
sub process_file {
    my($fname) = @_;
    my($short_fname) = ($fname eq "-" ? "STDIN" : basename($fname));
    my(@raw, $input, @output);
    my($line) = 1;
    my(@remaining);

    #
    # Right; now read in the raw file.
    #
    if ($input ne "-") {
        open(RAW, "<$fname");
        @raw = <RAW>;
        close(RAW);
    }
    else {
        @raw = <STDIN>;
    }

    @remaining = @raw;
    $depth++;
    &set_keyword('DEPTH', $depth);
    foreach $input (@raw) {
        #
        # Take this line off the list, so we can insert files at the front
        # at need..
        #
        &set_keyword('INPUT_LINE', $line);
        shift(@remaining);
        if ($input =~ m:^\.literal:) {
            $literal = 1;
            $line++;
            next;
        }
        elsif ($literal && ($input =~ m:^\.endliteral:)) {
            $literal = 0;
            $line++;
            next;
        }
        elsif ((! $literal) && $echo && ($input =~ m:\.margin\s+(\S+):i)) {
            my($newval) = &substitute_keywords($1, $undefined, %keywords);
            if ($newval =~ m:^\d+$:) {
                $margin = $newval;
                &set_keyword('MARGIN', $margin);
            }
            else {
                printf STDERR ("$0: malformed .margin directive "
                               . "at $short_fname:$line\n");
            }
            $line++;
            next;
        }
        elsif ((! $literal) && $echo && ($input =~ m:\.format\s+(\S+):i)) {
            my($newval) = &substitute_keywords($1, $undefined, %keywords);
            my(%result) =  &set_format($newval, 0);

            if (! %result) {
                printf STDERR ("$0: unrecognised format '$newval' at "
                               . "$short_fname:$line; format unchanged\n");
            }
            else {
                printf STDERR ("$0: format changed to $newval "
                               . "at $short_fname:$line\n")
                    if ($DEBUG);
                &push_format($output_line, $newval);
            }
            $line++;
            next;
        }
        elsif ((! $literal) && $echo && ($input =~ m:\.fill$:i)) {
            if (! $fill) {
                $fill = 1;
                &set_keyword('FILL', $fill);
            }
            $line++;
            next;
        }
        elsif ((! $literal) && ($input =~ m:\.endfill$:i)) {
            if ($fill) {
                $fill = 0;
                &set_keyword('FILL', $fill);
            }
            else {
                printf STDERR ("$0: .fill not active; .endfill ignored at "
                               . "$short_fname:$line\n");
            }
            $line++;
            next;
        }
        elsif ((! $literal) && $echo && ($input =~ m:^\.include\s+(.*):i)) {
            my($includeit) = 1;
            $dloc = dirname($inputfile);
            if ($1 eq "-") {
                $newfile = $1;
            }
            else {
                $newfile = $dloc . ($dloc ? "/" : "") . $1;
                if (! -f $newfile) {
                    printf STDERR ("$0: can't access include file "
                                   . "'$newfile' at $short_fname:$line\n");
                    $includeit = 0;
                }
            }
            if ($includeit) {
                printf STDERR ("$0: including contents of '$newfile' "
                               . "at $short_fname:$line\n")
                    if ($DEBUG);
                push(@output, &process_file($newfile));
            }
        }
        elsif ((! $literal) && ($input =~ m:^\.if\s+(.*):i)) {
            my($expr) = $1;

            #
            # Entering a conditional block.  Make a note of the 'indentation'
            # level, and note the current echo status as well as the new
            # one so .else processing will work.
            #
            $expr = &substitute_keywords($expr, $undefined, %keywords);
            $iflevel++;
            push(@ifstate, $echo);
            push(@ifstart, "$short_fname:$line");
            $outerecho = $echo;
            $echo = $echo ? eval($expr) : 0;
            if ($DEBUG && $outerecho) {
                print STDERR ("$0: .if-expression '$1' ('$expr') at "
                              . "$short_fname:$line "
                              . "$line evaluated to '$echo'\n");
            }
        }
        elsif ((! $literal) && ($input =~ m:^\.endif$:i)) {
            #
            # Close out a conditional block.  Decrement the if-level, and
            # display an error if we're trying to close something that
            # isn't open.
            #
            $iflevel--;
            if ($iflevel < 0) {
                printf STDERR ("$0: superfluous .endif at "
                               . "$short_fname:$line\n");
            }
            else {
                $echo = pop(@ifstate);
                pop(@ifstart);
            }
        }
        elsif ((! $literal) && ($input =~ m:^\.else$:i)) {
            #
            # Handle an alternate leg in a conditional block.
            #
            if ($iflevel < 1) {
                print STDERR ("$0: superfluous .else at $short_fname:$line\n");
            }
            else {
                $echo = $outerecho ? (! $echo) : 0;
            }
        }
        elsif ((! $literal) && ($input =~ m:^\.#:)) {
            #
            # This input line is a comment; ignore
            # it and do nothing.
            #
        }
        elsif ((! $literal) && $DEBUG && $echo && ($input =~ m:^\.dump$:i)) {
            foreach (sort(keys(%keywords))) {
                print STDERR ("$0: '$_' = '$keywords{$_}'\n");
            }
        }
        elsif ($echo) {
            #
            # Nothing special about this line, control flow-wise, and we're
            # in echo mode, so check for other directives or store the edited
            # text for output if it isn't a directive.
            #
            my($line) = $input;

            if ((! $literal) && ($input =~ m,^\.([^:\s]+):\s*(.*)$,)) {
                #
                # Only [re]define this name if it isn't one of the locked
                # ones.
                #
                &set_keyword($1, &substitute_keywords($2, $undefined,
                                                      %keywords));
            }
            else {
                if (! $literal) {
                    $line = &substitute_keywords($line, $undefined, %keywords);
                }
                push(@output, $line);
                $output_line++;
                &set_keyword('OUTPUT_LINE', $output_line);
            }
        }
        $line++;
    }
    $depth--;
    &set_keyword('DEPTH', $depth);
    return @output;
}

#
# Transformation handlers.  Each is called with an argument of "BEGIN"
# before the first line of text, in case it needs to do any setup or
# emit a sentinel such as "/*", and with "END" after the last line
# for a corresponding reason.  In between, it's called with two
# arguments: the line of text to transform (including the newline),
# and the length of the longest line that will need to be transformed
# (for any right-justification processing).
#
# The handler returns the text to be emitted, or undef.
#

#
# Convert an input line into something Perl can use as a comment.
#
sub make_perl {
    my($input, $longest) = @_;

    if (($input eq "BEGIN") || ($input eq "END")) {
	#
	# No special header or trailer processing.
	#
	return undef;
    }
    return "# $input";
}

#
# Convert an input line into plain text.
#
sub make_text {
    my($input, $longest) = @_;

    if (($input eq "BEGIN") || ($input eq "END")) {
	#
	# No special header or trailer processing.
	#
	return undef;
    }
    return $input;
}

#
# Convert an input line into comments for a man file.
#
sub make_man {
    my($input, $longest) = @_;

    if (($input eq "BEGIN") || ($input eq "END")) {
	#
	# No special header or trailer processing.
	#
	return undef;
    }
    return '.\" ' . $input;
}

#
# Convert an input line into a C++ comment.
#
sub make_cxx {
    my($input, $longest) = @_;

    if (($input eq "BEGIN") || ($input eq "END")) {
	#
	# No special header or trailer processing.
	#
	return undef;
    }
    return "// $input";
}

#
# Convert an input line into a block comment for C.
#
sub make_c_block {
    my($input, $longest) = @_;

    #
    # C block comments have special delimiters.
    #
    if ($input eq "BEGIN") {
	return "/**\n";
    }
    elsif ($input eq "END") {
	return " **/\n";
    }
    return " ** $input";
}

#
# Convert an input line into a line comment for C.
#
sub make_c_line {
    my($input, $longest) = @_;
    my($pad, $padw);
    my($edited) = $input;
    my($length);

    chomp($edited);
    $length = length($edited);
    $padw = $longest - $length;

    if (($input eq "BEGIN") || ($input eq "END")) {
	#
	# Generate a sentinel line..
	#
	return "/*" . ("*" x ($longest + 2)) . "*/\n";
    }

    $pad = " " x $padw;
    return "/* $edited$pad */\n";
}

#
# Convert an input line into an HTML comment.
#
sub make_html {
    my($input, $longest) = @_;
    my($edited, $pad) = ($input, "");
    my($padw);

    chomp($edited);
    $padw = $longest - length($edited);
    $pad = " " x $padw;

    if (($input eq "BEGIN") || ($input eq "END")) {
	#
	# Generate a sentinel line.
	#
	return "<!-- " . ("-" x $longest) . " -->\n";;
    }
    return "<!-- $edited$pad -->\n";
}

sub show_version {
    printf STDERR ("mklicence, @PACKAGE_VERSION@\n\n");
}

sub usage {
    &show_version();

    printf STDERR <<EOH;
usage: mklicence -f format [-l file] [-v] [-d] [-s] [-u undefined-string]
	[name:value ...]

  -d : enables rudimentary debugging, and the .dump directive
  -f : format of the output
  -h : displays this text
  -l : input file, containing text and definitions.  STDIN
       is used if omitted or is '-'
  -s : names defined by the command line cannot be overridden by definitions
       in the file.
  -u : sets the text string to substitute for undefined references.
  -v : displays the version.
EOH
}