#!/usr/bin/perl

package GenericPrepTemplate;

#BEGIN {
#    use Exporter ();
#    use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
#    $VERSION= 1.00;
#    @ISA= qw(Exporter);
#    @EXPORT= qw(&process_input);
#    %EXPORT_TAGS= ();
#    @EXPORT_OK= qw();
#}
#use vars @EXPORT_OK;
#use vars qw($fh);

use IO::Handle;
use IO::File;

open DEBUG, ">/dev/null" or die "gpt: /dev/null: $!\n";

while (@main::ARGV =~ m/^-/) {
    $_= shift @main::ARGV;
    next if m/^--$/;
    while (m/^-./) {
	if (s/^-d/-/) {
	    open DEBUG, ">&2" or die "gpt: debug to stderr: $!\n";
	} else {
	    die "gpt: unknown option \`$_'\n";
	}
    }
}

$fn= '<command line>';
if (!@main::ARGV) {
    $lno= '<empty>';
    $fh= new IO::Handle;
    $fh->fdopen(fileno(STDIN),'r') or err("fdopen stdin: $!");
    process_fh($fh,'<standard input>');
    $fh->close or err("close stdin: $!\n");
} else {
    for ($i=0; $i<@main::ARGV; $i++) {
	$lno= '<arg#'.($i+1).'>';
	$value= $main::ARGV[$i];
	$fh= new IO::File $value,'r' or err("cannot open file \`$value': $!");
	process_fh($fh,$value);
	$fh->close or err("gpt: cannot close file \`$value': $!");
    }
}
close STDOUT or die "gpt: close stdout: $!\n";
exit 0;

sub err ($) { die "gpt: $fn:$lno: $_[0]\n"; }

sub add_perl ($) {
    my ($str) = @_;
    if (@oplist>1) { $substr.= $str; }
    else { $expr.= $str; }
}

sub add_text ($) {
    my ($str) = @_;
    if (@oplist) { $substr.=$str; }
    else { output($str); }
}

sub eval_expr () {		
    my ($value);
    $@='';
    print DEBUG "E $fn:$lno:e\`$expr'\n";
    $value= do {
	package main;
	eval $GenericPrepTemplate::expr;
    };
    if (length $@) {
	chomp $@; err("error: $@");
    }
    print DEBUG "E $fn:$lno:v\`$value'\n";
    $value;
}

sub process_input () {
    my ($esc,$top,$want,$fh,$value,$wasyes);
    while (length $l) {
	print DEBUG "L $fn:$lno:",join('',@oplist),
	            ":`$l' e\`$expr' s\`$substr'\n";
	if (@oplist & 1) { # scanning perl
	    if ($l =~ m/(.)\@\@/m || $l =~ m/^()\@\@/m) {
		($to,$op,$esc,$l) = ($`,$1,$&,$');
		add_perl($to);
		if ($op =~ m/[ 0-9a-zA-Z_\;\)\}?]/ || $op eq '') {
		    $top= pop @oplist;
		    if (!@oplist) {
			# And evaluate.
			$expr.= $op unless $op =~ m/[?]/;
			$value= eval_expr();
			if ($top eq '<') {
			    process_file($value);
			} elsif ($top eq '?') {
			    push @oplist, '?',':;'.!!$value;
			} elsif ($top ne '-') {
			    output($value);
			}
			$expr='';
		    } else {
			$substr.= $esc;
		    }
		} elsif ($op =~ m/[\(\{]/) {
		    if (@oplist>1) { $substr.= $esc; }
		    push @oplist, $op;
		} else {
		    err("bad escape sequence $op\@\@ in perl part");
		}
	    } else {
		add_perl($l);
		$l= '';
	    }
	} else { # scanning text
	    if ($l =~ m/\@\@(.|\n)/) {
		($to,$op,$esc,$l) = ($`,$1,$&,$');
		add_text($to);
		if ($op =~ m/[-< \$?]/) {
		    $substr.= $esc if @oplist;
		    push @oplist, $op;
		} elsif ($op =~ m/[\)\}\;\:]/) {
		    err("unmatched closing \@\@$op") unless @oplist;
		    $want= pop @oplist;
		    if ($want =~ y/({/)}/) {
			$wasyes=-1;
			err("found \@\@$op but wanted \@\@$want")
			    unless $want eq $op;
		    } elsif ($want =~ m/^([:;]+)(1?)$/) {
			($want,$wasyes)=($1,$2);
			err("found \@\@$op where not expected (wanted ".
			    join(' or ', map { "\@\@$_" } split //, $want).")")
			    unless $op =~ m/^[$want]$/;
			'?' eq pop @oplist or die;
			if ($wasyes) {
			    local ($l) = ($substr);
			    local ($substr,$expr,$to,$op);
			    process_input();
			};
			$substr='';
			$esc='';
			if ($op eq ':') {
			    push @oplist, '?',';'.!$wasyes;
			}
		    } else {
			die "internal /$want/ /$op/";
		    }
		    if (@oplist==1) {
			# Just finished a substr.
			$substri++;
			$substrs[$substri]= $substr;
			print DEBUG "S $fn:$lno:S$substri\`$substr'\n";
			$expr.= ' GenericPrepTemplate::output(' if $op eq '}';
			$expr.= " GenericPrepTemplate::process_i($substri) ";
			$expr.= " );\n" if $op eq '}';
			$substr='';
		    } else {
			$substr.= $esc;
		    }
		} else {
		    err("bad escape sequence \@\@$op in text part");
		}
	    } else {
		add_text($l);
		$l= '';
	    }
	}
    }
}

sub process_fh ($$) {
    local ($fh,$fn) = @_;
    local ($l,$lno, @oplist,$substr,$expr,$to,$op);

    while (defined ($l= $fh->getline)) {
	next if $l =~ m,^\#\! ?/\S+/gpt\b, && $.==1;
	$lno= $.;
	process_input();
    }
    die "gpt: $fn: read error: $!" if $fh->error;
}

sub output ($) {
    if (defined $outbuf) {
	print DEBUG "O \`$outbuf'+\`$_[0]'\n";
	$outbuf.= $_[0];
    } else {
	print DEBUG "O w\`$_[0]'\n";
	print STDOUT $_[0] or err("write stdout: $!");
    }
}

sub process_i ($) {
    my ($i) = @_;
    local ($l,$fn,$lno) = ($substrs[$i], "$fn<sub#$i>", '');
    local ($outbuf, @oplist,$substr,$expr,$to,$op);
    $outbuf='';
    process_input();
    return $outbuf;
}