temple

   1 #!/usr/bin/perl
   2 # A really simple template engine
   3 # (c) 2004 Martin Mares <mj@ucw.cz>
   4
   5 use strict;
   6 use warnings;
   7 no strict 'vars';
   8
   9 use IO::File;
  10
  11 our @cond;
  12 our $temp;
  13
  14 sub get_nested($$$) {
  15         my ($r,$left,$right) = @_;
  16         pos $$r = pos($$r)-1;
  17         my $z = "";
  18         my $nest = 0;
  19         do {
  20                 if ($$r =~ /\G([^$left$right]+)/cgs) {
  21                 } elsif ($$r =~ /\G([$left])/cgs) {
  22                         $nest++;
  23                 } elsif ($$r =~ /\G([$right])/cgs) {
  24                         $nest--;
  25                 } else {
  26                         die "File ended when looking for matching $right";
  27                 }
  28                 $z .= $1;
  29         } while ($nest);
  30         return $z;
  31 }
  32
  33 sub eval_if_ok($) {
  34         if ($cond[0] > 0) {
  35                 my $x = shift;
  36                 my $res = eval $x;
  37                 return $res unless $@;
  38                 die "Error evaluating $x: $@";
  39         } else {
  40                 return "";
  41         }
  42 }
  43
  44 sub eval_func($$) {
  45         my ($f, $a) = @_;
  46         if ($f =~ /^(if|fi|else|elif)$/) {
  47                 if ($f eq "if") {
  48                         $a ne "()" or die "\@if requires an argument";
  49                         if ($cond[0] > 0) {
  50                                 unshift @cond, (eval_if_ok($a) ? 1 : -1);
  51                         } else {
  52                                 unshift @cond, 0;
  53                         }
  54                 } elsif ($f eq "fi") {
  55                         $a eq "()" or die "\@fi takes no arguments";
  56                         $#cond or die "\@fi without \@if";
  57                         shift @cond;
  58                 } elsif ($f eq "else") {
  59                         $a eq "()" or die "\@else takes no arguments";
  60                         $#cond or die "\@else without \@if";
  61                         $cond[0] = -$cond[0];
  62                 } elsif ($f eq "elif") {
  63                         $a ne "()" or die "\@elif requires an argument";
  64                         $#cond or die "\@elif without \@if";
  65                         if ($cond[0] > 0) {
  66                                 $cond[0] = 0;
  67                         } elsif ($cond[0] < 0) {
  68                                 $cond[0] = 1;
  69                                 $cond[0] = (eval_if_ok($a) ? 1 : -1);
  70                         }
  71                 }
  72                 # print "Cond stack: @cond\n";
  73         } else {
  74                 eval_if_ok("$f($a)");
  75         }
  76 }
  77
  78 sub process_string($) {
  79         my ($t) = @_;
  80         pos $t = 0;
  81         for(;;) {
  82                 if ($t =~ /\G([^\@]+)/cgs) {
  83                         print $1 if $cond[0] > 0;
  84                 } elsif ($t =~ /\G\@\s*\n/cgs) {
  85                         # @ at end of line is ignored and eats the end of line
  86                 } elsif ($t =~ /\G\@#[^\n]*\n/cgs) {
  87                         # a comment, which is ignored
  88                 } elsif ($t =~ /\G\@{/cgs) {
  89                         my $x = get_nested(\$t, "{", "}");
  90                         print eval_if_ok($x);
  91                 } elsif ($t =~ /\G\@\[/cgs) {
  92                         my $x = get_nested(\$t, '\[', '\]');
  93                         $x =~ s/^\[//;
  94                         $x =~ s/$\]//;
  95                         eval_if_ok($x);
  96                 } elsif ($t =~ /\G\@(\w+)\(/cgs) {
  97                         my $func = $1;
  98                         my $args = get_nested(\$t, '(', ')');
  99                         eval_func($func, $args);
 100                 } elsif ($t =~ /\G\@(\w+)([^\n]*)\n/cgs) {
 101                         eval_func($1, "($2)");
 102                 } elsif ($t =~ /\G\@(\$\w+)/cgs) {
 103                         print eval_if_ok($1);
 104                 } elsif ($t =~ /\G(\@[^\n]*)/cgs) {
 105                         die "Unknown directive $1";
 106                 } elsif ($t =~ /\G$/cgs) {
 107                         last;
 108                 } elsif ($t =~ /\G([^\n]*)/cgs) {
 109                         die "Internal parser error at $1 (pos " . pos($t) . ")";
 110                 } else { die; }
 111         }
 112 }
 113
 114 sub process_file($) {
 115         my ($name) = @_;
 116         my $fh = new IO::File $name;
 117         die "Unable to open $name: $!" unless defined $fh;
 118         my $text;
 119         { local $/; undef $/; $text = <$fh>; }
 120         undef $fh;
 121         process_string($text);
 122 }
 123
 124 sub include {
 125         my $fn = shift @_;
 126         while (@_) {
 127                 my $v = shift @_;
 128                 $temp = shift @_;
 129                 eval_if_ok("\$$v = \$temp");
 130         }
 131         process_file($fn);
 132 }
 133
 134 sub load {
 135         my $f = shift @_;
 136         (!defined $f || @_) and die "\@load requires only one argument";
 137         require $f;
 138 }
 139
 140 sub temple_start()
 141 {
 142         @cond = (1);
 143 }
 144
 145 sub temple_finish()
 146 {
 147         $#cond and die "Unterminated \@if (depth $#cond)";
 148 }
 149
 150 if (@ARGV != 2) {
 151         die "Usage: temple <in> <out>";
 152 } else {
 153         close STDOUT;
 154         open STDOUT, ">$ARGV[1]" or die "Cannot open $ARGV[1]: $!";
 155         temple_start();
 156         process_file($ARGV[0]);
 157         temple_finish();
 158 }