From aaabcb55245b32bff88915cbe16a2c6dc6cff112 Mon Sep 17 00:00:00 2001
From: Martin Mares <mj@ucw.cz>
Date: Wed, 22 Sep 2004 19:00:46 +0000
Subject: [PATCH] First version.

---
 temple | 158 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 158 insertions(+)
 create mode 100755 temple

diff --git a/temple b/temple
new file mode 100755
index 0000000..8257f4c
--- /dev/null
+++ b/temple
@@ -0,0 +1,158 @@
+#!/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();
+}
-- 
2.39.5