utils.pl

   1 # Various utility functions, including template substitution.
   2 #
   3 # Copyright (C) 1999 Ian Jackson <ijackson@chiark.greenend.org.uk>
   4 #
   5 # This is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as
   7 # published by the Free Software Foundation; either version 2,
   8 # or (at your option) any later version.
   9 #
  10 # This is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public
  16 # License along with this file; if not, write to the Free Software
  17 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18
  19 open RAND,"/dev/urandom" or die $!;
  20
  21 sub process_file ($) {
  22     local ($filename) = @_;
  23
  24     open X, "$filename" or die "$filename: $!";
  25     @x= <X>;
  26     close X or die $!;
  27
  28     $x[$#x] eq "\@\@\@eof:\@\@\@\n" or die $!;
  29     $#x--;
  30
  31     $cl= 0;
  32     $out= '';
  33     $level= -1;
  34     process(1);
  35 }
  36
  37 sub randnybs ($) {
  38     my ($nybbles) = @_;
  39     my ($v, $r, $bytes);
  40     $bytes= $nybbles/2;
  41     read(RAND,$v,$bytes) == $bytes or die $!;
  42     $r= scalar unpack("H$nybbles",$v);
  43 print DEBUG "randnybs($nybbles) -> $r\n";
  44     return $r;
  45 }
  46
  47 sub out ($) {
  48     $out.= $_[0]."\n";
  49 }
  50
  51 sub process ($) {
  52     my ($doing) = @_;
  53     my ($bcl);
  54     $level++;
  55     for (;;) {
  56         return if $cl > $#x;
  57         $_= $x[$cl++];
  58         s/\n$//; s/\s*$//;
  59 #       out("<!-- $level $doing $_ -->");
  60         last if m/^\@\@\@end\w+\:\@\@\@$/;
  61
  62         if (m/^\@\@\@(if|ifnot):([0-9a-z_|]+)\@\@\@$/) {
  63             $q=$1; $v=$2;
  64             $do= 0;
  65             if ($doing) {
  66                 map { $do=1 if getvar($_); } split(/\|/,$v);
  67                 $do= !$do if $q eq 'ifnot';
  68 #               out("<!-- $level $doing $do $q $v $_ -->");
  69             }
  70             process($doing && $do);
  71         } elsif (m/^\@\@\@foreach\:(area|db)\@\@\@$/) {
  72             if ($doing) {
  73                 $bcl= $cl;
  74                 for (&{"foreach_start_$1"};
  75                      &{"foreach_cond_$1"};
  76                      &{"foreach_incr_$1"}) {
  77                     &{"foreach_setvars_$1"};
  78                     process($doing);
  79                     $cl= $bcl;
  80                 }
  81             }
  82             process(0);
  83         } elsif (m/^\@\@\@comment\:(\s.*)?$/) {
  84         } elsif (m/\S/) {
  85             s/^\@\@\@$//;
  86             if ($doing) {
  87                 s/\@\@\@(\w+)\@\@\@/ getvar("$1") /ge;
  88                 out($_);
  89             } else {
  90                 s/\@\@\@\w+\@\@\@//g;
  91             }
  92             die "$filename:$cl:unknown $_\n" if m/\@\@\@/;
  93         }
  94     }
  95     $level--;
  96 }
  97
  98 sub getvar ($) {
  99     my ($vn) = @_;
 100     defined $$vn or die "$filename:$cl:undefined $vn\n$out";
 101     return $$vn;
 102 }
 103
 104 %saniarray= ('<','lt', '>','gt', '&','amp', '"','quot');
 105 sub html_sani {
 106     local ($in) = @_;
 107     local ($out);
 108     while ($in =~ m/[<>&"]/) {
 109         $out.= $`. '&'. $saniarray{$&}. ';';
 110         $in=$';
 111     }
 112     $out.= $in;
 113     $out;
 114 }
 115
 116 1;