-#!/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) {
- 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);
+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();