#!/usr/bin/perl
# A really simple template engine
# (c) 2004 Martin Mares <mj@ucw.cz>

use strict;
use warnings;
no strict 'vars';

use IO::File;

our @cond;
our $temp;

sub get_nested($$$) {
	my ($r,$left,$right) = @_;
	pos $$r = pos($$r)-1;
	my $z = "";
	my $nest = 0;
	do {
		if ($$r =~ /\G([^$left$right]+)/cgs) {
		} elsif ($$r =~ /\G([$left])/cgs) {
			$nest++;
		} elsif ($$r =~ /\G([$right])/cgs) {
			$nest--;
		} else {
			die "File ended when looking for matching $right";
		}
		$z .= $1;
	} while ($nest);
	return $z;
}

sub eval_if_ok($) {
	if ($cond[0] > 0) {
		my $x = shift;
		my $res = eval $x;
		return $res unless $@;
		die "Error evaluating $x: $@";
	} else {
		return "";
	}
}

sub eval_func($$) {
	my ($f, $a) = @_;
	if ($f =~ /^(if|fi|else|elif)$/) {
		if ($f eq "if") {
			$a ne "()" or die "\@if requires an argument";
			if ($cond[0] > 0) {
				unshift @cond, (eval_if_ok($a) ? 1 : -1);
			} else {
				unshift @cond, 0;
			}
		} elsif ($f eq "fi") {
			$a eq "()" or die "\@fi takes no arguments";
			$#cond or die "\@fi without \@if";
			shift @cond;
		} elsif ($f eq "else") {
			$a eq "()" or die "\@else takes no arguments";
			$#cond or die "\@else without \@if";
			$cond[0] = -$cond[0];
		} elsif ($f eq "elif") {
			$a ne "()" or die "\@elif requires an argument";
			$#cond or die "\@elif without \@if";
			if ($cond[0] > 0) {
				$cond[0] = 0;
			} elsif ($cond[0] < 0) {
				$cond[0] = 1;
				$cond[0] = (eval_if_ok($a) ? 1 : -1);
			}
		}
		# print "Cond stack: @cond\n";
	} else {
		eval_if_ok("$f($a)");
	}
}

sub process_string($) {
	my ($t) = @_;
	pos $t = 0;
	for(;;) {
		if ($t =~ /\G([^\@]+)/cgs) {
			print $1 if $cond[0] > 0;
		} elsif ($t =~ /\G\@\s*\n/cgs) {
			# @ at end of line is ignored and eats the end of line
		} elsif ($t =~ /\G\@#[^\n]*\n/cgs) {
			# a comment, which is ignored
		} elsif ($t =~ /\G\@{/cgs) {
			my $x = get_nested(\$t, "{", "}");
			print eval_if_ok($x);
		} elsif ($t =~ /\G\@\[/cgs) {
			my $x = get_nested(\$t, '\[', '\]');
			$x =~ s/^\[//;
			$x =~ s/$\]//;
			eval_if_ok($x);
		} elsif ($t =~ /\G\@(\w+)\(/cgs) {
			my $func = $1;
			my $args = get_nested(\$t, '(', ')');
			eval_func($func, $args);
		} elsif ($t =~ /\G\@(\w+)([^\n]*)\n/cgs) {
			eval_func($1, "($2)");
		} elsif ($t =~ /\G\@(\$\w+)/cgs) {
			print eval_if_ok($1);
		} elsif ($t =~ /\G(\@[^\n]*)/cgs) {
			die "Unknown directive $1";
		} elsif ($t =~ /\G$/cgs) {
			last;
		} elsif ($t =~ /\G([^\n]*)/cgs) {
			die "Internal parser error at $1 (pos " . pos($t) . ")";
		} else { die; }
	}
}

sub process_file($) {
	my ($name) = @_;
	my $fh = new IO::File $name;
	die "Unable to open $name: $!" unless defined $fh;
	my $text;
	{ local $/; undef $/; $text = <$fh>; }
	undef $fh;
	process_string($text);
}

sub include {
	my $fn = shift @_;
	while (@_) {
		my $v = shift @_;
		$temp = shift @_;
		eval_if_ok("\$$v = \$temp");
	}
	process_file($fn);
}

sub load {
	my $f = shift @_;
	(!defined $f || @_) and die "\@load requires only one argument";
	require $f;
}

sub temple_start()
{
	@cond = (1);
}

sub temple_finish()
{
	$#cond and die "Unterminated \@if (depth $#cond)";
}

if (@ARGV != 2) {
	die "Usage: temple <in> <out>";
} else {
	close STDOUT;
	open STDOUT, ">$ARGV[1]" or die "Cannot open $ARGV[1]: $!";
	temple_start();
	process_file($ARGV[0]);
	temple_finish();
}