First version.

diff --git a/temple b/temple
new file mode 100755 (executable)
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();
+}