temple -e

[temple.git] / temple

diff --git a/temple b/temple
index 8257f4cd6213cb9e8ed7e14c74db50a77cd7daaa..b1301a6055e71718322e120bb6b5ee2fe80eb14e 100755 (executable)
--- a/temple
+++ b/temple
@@ -1,158 +1,28 @@
-#!/usr/bin/perl
+#!/usr/bin/perl -CSA
 # A really simple template engine
 # (c) 2004 Martin Mares <mj@ucw.cz>
 
 use strict;
 use warnings;
-no strict 'vars';
+use lib '.';
 
-use IO::File;
+use Getopt::Long;
+use UCW::Temple;
 
-our @cond;
-our $temp;
+my $out;
+my @execs = ();
 
-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);
+GetOptions('out|o=s' => \$out, 'exec|e=s' => \@execs) or die "Usage: temple [-o <out>] [-e <string>] <in> ...";
+if (defined $out) {
+       close STDOUT;
+       open STDOUT, '>:utf8', $out or die "Cannot open $out: $!";
 }
-
-sub temple_finish()
-{
-       $#cond and die "Unterminated \@if (depth $#cond)";
+if (!@ARGV) { push @ARGV, "-"; }
+UCW::Temple::start();
+foreach (@execs) {
+       UCW::Temple::parse_string($_, "-e");
 }
-
-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();
+foreach (@ARGV) {
+       UCW::Temple::parse_file($_);
 }
+UCW::Temple::finish();