#!/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, ">&4";

$fh= new IO::Handle;
$fh->fdopen(fileno(STDIN),'r') or die;
process_fh($fh,'<standard input>');
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 process_input () {
    my ($esc,$top,$want,$fh,$value);
    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;
			$@='';
			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";
			if ($top eq '<') {
			    $fh= new IO::File $value,'r'
				or err("cannot open file \`$value': $!");
			    process_fh($fh,$value);
			    $fh->close;
			} 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;
		    my ($want);
		    $want= $oplist[$#oplist] eq '(' ? ')' : '}';
		    err("found \@\@$op but wanted \@\@$want")
			unless $want eq $op;
		    pop @oplist;
		    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;
}