#!/usr/bin/perl
# FILE pfml.pl
#
# PFML (pseudo format markup language) processor
# Copyright 1997, 1998 Daniel Kahlin <daniel@kahlin.net>
#
# TODO:
#   - keywords '.ifn', '.ifdef', '.ifndef', '.elsif', '.literal'
#   - keywords '.noempty', '.empty' (disable/enable empty lines)
#   - keyword '.print'
#   - keyword '.link' (mark a link to be checked by a future linkchecker)
#   - keyword '.require' (require atleast this version of pfml)
#   - make provision for including filesizes into the text
#   - better error check
#   - real parameters
#   - multiline definitions
#
# HISTORY:
#   pfml 0.0.1 (21.10.97) tlr - works partly
#   pfml 0.0.2 (22.10.97) tlr - works with includes!
#   pfml 0.0.3 (22.10.97) tlr - if works ok!
#   pfml 0.0.4 (22.10.97) tlr - handles arguments correctly!
#   pfml 0.0.5 (23.10.97) tlr - poked around in source, added option -s
#                               to suppress banner.
#   pfml 0.0.6 (27.10.97) tlr - added some TODOs, and cleaned up a bit.
#   pfml 0.0.7 (10.7.98)  tlr - just modified pfmlrc.pfml and index.pfml
#
$PFML_VERSION="0.0.7";

use Getopt::Std;

sub process_file ($);

#
# the MAIN code
#
# checks command line arguments
# prints help if appropriate, calls process_file() for
# all specified files.
#
getopts ('svdhp:');

$verbose=$opt_v;
$debug=$opt_d;
$place="HOME" unless ($place=$opt_p);

if (!$opt_s) {
    print <<EOF;
pfml.pl $PFML_VERSION - PFML (pseudo format markup language) processor
Copyright (c) 1997, 1998 Daniel Kahlin <daniel\@kahlin.net>
EOF
}

# print help and exit if -h
if ($opt_h) {
    print <<EOF;
USAGE: pfml.pl [-h][-s][-v][-d][-p] files...
  -h display this help text
  -s suppress banner
  -v be verbose
  -d dump lots of (weird) debugging info
  -p sets the PLACE variable (default HOME)
EOF
    exit 0;
}

#
# process each file in turn
#
foreach $file (@ARGV) {
    process_file($file);
}

exit 0;


#
# sub process_file ($)
#
# Processes the file specified, goes through all include files.
# This probably should be done in a recursive manner, but hey
# it works! ;) 
#
sub process_file ($)
{
    my $inname=shift;
    ($outname = $inname) =~ s/.pfml/.html/g;

    print "processing: ", $inname, " -> ", $outname, "\n" if $verbose;

    #
    # OPEN FILES
    #

    $filenum=1;

    $fhname="INFILE_$filenum";
    $filenum++;
    open $fhname, "<$inname" or die $0, ": can't open input file\n";
    push @file_stack, $fhname;
    $fhname="INFILE_$filenum";
    $filenum++;
    open $fhname, "<linkdefs.pfml" and push @file_stack, $fhname;
    $fhname="INFILE_$filenum";
    $filenum++;
    open $fhname, "<pfmlrc.pfml" and push @file_stack, $fhname;


    open OUTFILE, ">$outname" or die $0, ": can't open outputfile\n";

    # default to generating code!
    $if_state=1;

    #
    # set default '.sets'
    #
    %set = ();
    $set{PFML}=TRUE;
    $set{PFML_VERSION}=$PFML_VERSION;
    $set{PLACE}=$place;
    $set{NEVERUSED}=1;
    $set{INFILE}=$inname;
    $set{OUTFILE}=$outname;

    #
    # Main processor loop!
    #
    while (defined ($in_fh = pop @file_stack)) {
	while ($line = <$in_fh>) {
	    next if $line =~ /^(\t| )*#/;    # skip lines beginning with hash

	    #
	    # CHECK IF A '.' COMMAND
	    #
	    if ($line =~ /^(\t| )*\./) {
		print "parse: ", $line if $debug;
		@words = split ' ', $line;
		$numargs = @words;
		$cmd = $words[0];

		#
		# first check for '.endif'
		#
		if ($cmd eq ".endif") {
		    ($numargs == 1) or die $0, ": wrong number of arguments\n";
		    defined ($if_state = pop @if_stack) or die $0, ": .endif without .if\n";
		    print ".endif\n" if $debug;

		#
		# process .if
		#
		} elsif ($cmd eq ".if") {
		    ($numargs == 3) or die $0, ": wrong number of arguments\n";
		    $name=$words[1];
		    $expansion=$set{$name};
		    push @if_stack, $if_state;
		    $if_state = ($expansion eq $words[2]) if ($if_state);
		    print ".if\n" if $debug;

	        #
	        # process .else
	        #
		} elsif ($cmd eq ".else") {
		    ($numargs == 1) or die $0, ": wrong number of arguments\n";
		    $if_state=!$if_state;
		    print ".if\n" if $debug;

	        #
		# do not proceed if if_state is false!
		#
		} elsif (!$if_state) {
		    print "nocode " , $cmd, "\n" if $debug;

	        #
	        # if '.set' try to define the variable
	        #
		} elsif ($cmd eq ".set") {
		    ($numargs == 3) or die $0, ": wrong number of arguments\n";
		    $name=$words[1];
		    $expansion=$words[2];
		    defined $set{$name} and die $0, ": ", $name, " already defined\n";
		    $set{$name}=$expansion;
		    print ".set: ", $name, " -> ", $expansion, "\n" if $debug;

 	        #
	        # if '.unset' try to undefine the variable
	        #
		} elsif ($cmd eq ".unset") {
		    ($numargs == 2) or die $0, ": wrong number of arguments\n";
		    $name=$words[1];
		    defined $set{$name} or die $0, ": ", $name, " not defined\n";
		    undef $set{$name};
		    print ".unset: ", $name, "\n" if $debug;

		#
		# if '.include' try to include a new file
		#
		} elsif ($cmd eq ".include") {
		    ($numargs == 2) or die $0, ": wrong number of arguments\n";
		    $name=$words[1];
		    push @file_stack, $in_fh;
		    $fhname="INFILE_$filenum";
		    $filenum++;
		    open $fhname, "<$name" or die $0, ": can't open $name for reading\n";
		    $in_fh = $fhname;
		    print ".include '", $name, "'\n" if $debug;

		} else {
		    die $0, ": ", "syntax error\n";
		}
		next;
	    }

	    #
	    # DO SUBSTITUTIONS:
	    # if we find '${NAME}' in the indata we substitute this
	    # for the contents of the perl variable $set{NAME}
	    # and it supports recursion (but if you make an infinite
	    # recursion this will surely crash ;)
	    #
	    while ($line =~ /\$\{(.*?)\}/) {
		$name=$1;
		defined $set{$name} or die $0, ": ", $name, " not defined\n";
		$expansion=$set{$name};
		print "subst: ", $name," -> ",$expansion, "\n" if $debug;
		$line =~ s/\$\{(.*?)\}/$expansion/;
	    }

	    #
	    # DO SUBSTITUTIONS 2:
	    # \<  &lt;
	    # \>  &gt;
	    # \\  \
	    # \$  $
	    # \#  #
	    # \.  .
	    # \{  {
	    # \}  }
	    #
	    $line =~ s/\\</&lt;/g;
	    $line =~ s/\\>/&gt;/g;
	    $line =~ s/\\\\/\\/g;
	    $line =~ s/\\\$/\$/g;
	    $line =~ s/\\#/#/g;
	    $line =~ s/\\\./\./g;
	    $line =~ s/\\\{/\{/g;
	    $line =~ s/\\\}/\}/g;

	    #
	    # OUTPUT THE PROCESSED LINE
	    #
	    print OUTFILE $line if ($if_state);
	}
	close $in_fh;
    }


    #
    # clean up!
    #
    close OUTFILE;
}


#
# eof
#