Converted to Perl module.

diff --git a/UCW/Temple.pm b/UCW/Temple.pm
new file mode 100755 (executable)
index 0000000..41af968
--- /dev/null
+++ b/UCW/Temple.pm
@@ -0,0 +1,168 @@
+#!/usr/bin/perl
+# A really simple template engine
+# (c) 2004 Martin Mares <mj@ucw.cz>
+
+package UCW::Temple;
+
+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 parse_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) {
+                       print "\@";
+               } 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 control sequence $1";
+               } elsif ($t =~ /\G$/cgs) {
+                       last;
+               } elsif ($t =~ /\G([^\n]*)/cgs) {
+                       die "Internal parser error at $1 (pos " . pos($t) . ")";
+               } else { die; }
+       }
+}
+
+sub parse_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;
+       parse_string($text);
+}
+
+sub start()
+{
+       @cond = (1);
+}
+
+sub finish()
+{
+       $#cond and die "Unterminated \@if (depth $#cond)";
+}
+
+sub process_file($) {
+       start();
+       parse_file($_[0]);
+       finish();
+}
+
+sub process_string($) {
+       start();
+       parse_string($_[0]);
+       finish();
+}
+
+### Commands available from the templates
+
+sub include {
+       my $fn = shift @_;
+       while (@_) {
+               my $v = shift @_;
+               $temp = shift @_;
+               eval_if_ok("\$$v = \$temp");
+       }
+       parse_file($fn);
+}
+
+sub load {
+       my $f = shift @_;
+       (!defined $f || @_) and die "\@load requires only one argument";
+       require $f;
+}
+
+1;

diff --git a/temple b/temple
index e8d2072d49d730ad9652fa45cb3f1ece7a191d78..6f0748327727a0a7b25f41e4049357e48b930ea5 100755 (executable)
--- a/temple
+++ b/temple
@@ -4,157 +4,15 @@
 
 use strict;
 use warnings;
-no strict 'vars';
 
-use IO::File;
+use UCW::Temple;
 
-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) {
-                       print "\@";
-               } 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 control sequence $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 {
+if (@ARGV == 1) {
+       UCW::Temple::process_file($ARGV[0]);
+} elsif (@ARGV == 2) {
        close STDOUT;
        open STDOUT, ">$ARGV[1]" or die "Cannot open $ARGV[1]: $!";
-       temple_start();
-       process_file($ARGV[0]);
-       temple_finish();
+       UCW::Temple::process_file($ARGV[0]);
+} else {
+       die "Usage: temple <in> [<out>]";
 }