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                         print "\@";
  90                 } elsif ($t =~ /\G\@{/cgs) {
  91                         my $x = get_nested(\$t, "{", "}");
  92                         print eval_if_ok($x);
  93                 } elsif ($t =~ /\G\@\[/cgs) {
  94                         my $x = get_nested(\$t, '\[', '\]');
  95                         $x =~ s/^\[//;
  96                         $x =~ s/$\]//;
  97                         eval_if_ok($x);
  98                 } elsif ($t =~ /\G\@(\w+)\(/cgs) {
  99                         my $func = $1;
 100                         my $args = get_nested(\$t, '(', ')');
 101                         eval_func($func, $args);
 102                 } elsif ($t =~ /\G\@(\w+)([^\n]*)\n/cgs) {
 103                         eval_func($1, "($2)");
 104                 } elsif ($t =~ /\G\@(\$\w+)/cgs) {
 105                         print eval_if_ok($1);
 106                 } elsif ($t =~ /\G(\@[^\n]*)/cgs) {
 107                         die "Unknown control sequence $1";
 108                 } elsif ($t =~ /\G$/cgs) {
 109                         last;
 110                 } elsif ($t =~ /\G([^\n]*)/cgs) {
 111                         die "Internal parser error at $1 (pos " . pos($t) . ")";
 112                 } else { die; }
 113         }
 114 }
 115
 116 sub process_file($) {
 117         my ($name) = @_;
 118         my $fh = new IO::File $name;
 119         die "Unable to open $name: $!" unless defined $fh;
 120         my $text;
 121         { local $/; undef $/; $text = <$fh>; }
 122         undef $fh;
 123         process_string($text);
 124 }
 125
 126 sub include {
 127         my $fn = shift @_;
 128         while (@_) {
 129                 my $v = shift @_;
 130                 $temp = shift @_;
 131                 eval_if_ok("\$$v = \$temp");
 132         }
 133         process_file($fn);
 134 }
 135
 136 sub load {
 137         my $f = shift @_;
 138         (!defined $f || @_) and die "\@load requires only one argument";
 139         require $f;
 140 }
 141
 142 sub temple_start()
 143 {
 144         @cond = (1);
 145 }
 146
 147 sub temple_finish()
 148 {
 149         $#cond and die "Unterminated \@if (depth $#cond)";
 150 }
 151
 152 if (@ARGV != 2) {
 153         die "Usage: temple <in> <out>";
 154 } else {
 155         close STDOUT;
 156         open STDOUT, ">$ARGV[1]" or die "Cannot open $ARGV[1]: $!";
 157         temple_start();
 158         process_file($ARGV[0]);
 159         temple_finish();
 160 }