selfforum-cgi/shared/Template.pm

   1 package Template;
   2
   3 ################################################################################
   4 #                                                                              #
   5 # File:        shared/Template.pm                                              #
   6 #                                                                              #
   7 # Authors:     André Malo <nd@o3media.de>, 2001-04-12                          #
   8 #              Frank Schoenmann <fs@tower.de>, 2001-06-04                      #
   9 #                                                                              #
  10 # Description: Handle XML based HTML-Templates                                 #
  11 #                                                                              #
  12 ################################################################################
  13
  14 use strict;
  15 use vars qw($xml_dom_used);
  16
  17 use Carp qw(croak confess);
  18
  19 BEGIN {
  20   $xml_dom_used = eval q[
  21     local $SIG{__DIE__};
  22     use XML::DOM;
  23     1;
  24   ];
  25 }
  26
  27 ### sub new ####################################################################
  28 #
  29 # constructor
  30 #
  31 # Params: ~none~
  32 #
  33 # Return: Template object
  34 #
  35 sub new {
  36   my $instance = shift;
  37
  38   my $self = bless {} => ref($instance) || $instance;
  39
  40   $self -> file (+shift);
  41
  42   # return
  43   $self;
  44 }
  45
  46 ### sub file ###################################################################
  47 #
  48 # assign new template file to object
  49 # parse the template file
  50 #
  51 # Params: $new - (optional) new template file
  52 #
  53 # Return: scalar - old filename or if there's no old filename given
  54 #
  55 sub file {
  56   my $self = shift;
  57   my $new  = shift;
  58   my $old  = $self -> {file};
  59
  60   $self -> {file} = $new if (defined $new);
  61   $self -> parse_file;
  62
  63   # return
  64   $old;
  65 }
  66
  67 ### sub insert #################################################################
  68 #
  69 # return the placeholder surrounded by meta delimiters
  70 #
  71 # Params: $name - name of placeholder
  72 #
  73 # Return: scalar - placeholder surrounded by meta delimiters
  74 #
  75 sub insert {
  76   my $self = shift;
  77   my $name = shift;
  78
  79   croak "no template file specified"
  80     unless (defined $self -> {file});
  81
  82   # return
  83   $self -> {metaon} . $name . $self -> {metaoff};
  84 }
  85
  86 ### sub list ###################################################################
  87 #
  88 # fill in a complete list
  89 #
  90 # Params: $name  - name of the atomic scrap
  91 #         $array - list of hashes (same strcuture like the hash used by 'scrap')
  92 #
  93 # Return: scalar reference - filled in list
  94 #
  95 sub list {
  96   my $self = shift;
  97   my $name = shift;
  98
  99   croak "no template file specified"
 100     unless (defined $self -> {file});
 101
 102 #  no warnings 'uninitialized';
 103   my $list = join '' => map { ${ $self -> scrap ($name, $_) } } @{ +shift };
 104
 105   # return
 106   \$list;
 107 }
 108
 109 ### sub scrap ##################################################################
 110 #
 111 # fill in a template scrap
 112 #
 113 # Params: $name    name of the scrap
 114 #         ...
 115 #         $no_nl   1 - remove newlines (\n)
 116 #                  0 - do no such thing
 117 #
 118 # Return: scalar reference - filled in scrap
 119 #
 120 sub scrap {
 121   my $self = shift;
 122   my $name = shift;
 123
 124   my $no_nl;
 125   if (!ref $_[$#_]) {
 126       $no_nl = pop @_;
 127   }
 128
 129   croak "no template file specified"
 130     unless (defined $self -> {file});
 131
 132   return \'' unless (defined $name and defined ($self -> {parsed} -> {$name}));
 133
 134   # fetch parameters
 135   # (and normalize - save only the references in %params)
 136   #
 137   my %params;
 138   %params = map {
 139     my $ref = $_;
 140     map {
 141       ($_ => (
 142         ref ($ref -> {$_})
 143         ? (defined ${$ref -> {$_}} ? $ref -> {$_} : \'')
 144         : \(defined $ref -> {$_} ? $ref -> {$_} : ''))
 145       )
 146     } keys %$ref
 147   } splice @_;
 148
 149   # fill in...
 150   #
 151   my $scrap = $self -> {parsed} -> {$name};
 152   my $qmon  = quotemeta $self -> {metaon};
 153   my $qmoff = quotemeta $self -> {metaoff};
 154
 155   # ...until we've replaced all placeholders
 156   #
 157   1 while (
 158       $scrap =~ s
 159       <
 160         $qmon \s*
 161         ([_a-zA-Z] \S*)
 162         \s* $qmoff
 163       >
 164       [ (exists ( $params{$1} ) )
 165         ? ${$params{$1}}
 166         : ( exists ( $self -> {parsed} -> {$1} )
 167             ? $self -> {parsed} -> {$1}
 168             : ''
 169           );
 170       ]gex
 171     );
 172
 173   # parse conditional blocks
 174   #
 175   $self -> parse_if (
 176     \$scrap,
 177     \%params
 178   );
 179
 180   # remove newlines
 181   $scrap =~ s/\n|\r\n|\n\r|\r//g if ($no_nl);
 182
 183   # return
 184   \$scrap;
 185 }
 186
 187 ### sub parse_file #############################################################
 188 #
 189 # read in and parse template file
 190 #
 191 # Params: ~none~
 192 #
 193 # Return: Status Code (Boolean)
 194 #
 195 sub parse_file {
 196   my $self = shift;
 197   my $filename = $self -> {file};
 198
 199   if ($xml_dom_used) {
 200
 201     # parse template using XML::DOM
 202     #
 203     my $xml = eval {
 204       local $SIG{__DIE__};
 205       new XML::DOM::Parser -> parsefile ($filename);
 206     };
 207     croak "error while parsing template file '$filename': $@" if ($@);
 208
 209     my $template = $xml -> getElementsByTagName ('Template', 0) -> item (0);
 210
 211     # extract meta delimiters
 212     #
 213     $self -> {metaon}  = $template -> getAttribute ('metaon');
 214     $self -> {metaoff} = $template -> getAttribute ('metaoff');
 215
 216     croak "missing meta defintion(s) in template file '$filename'." unless ($self -> {metaon} and $self -> {metaoff});
 217
 218     $self -> {parsed} = {};
 219     foreach ($template -> getElementsByTagName ('Scrap', 0)) {
 220       my $name = $_ -> getAttribute ('id');
 221
 222       croak "Element 'Scrap' requires attribute 'id' in template file '$filename'." unless (length ($name));
 223       croak "double defined id '$name' in template file '$filename'." if (exists ($self -> {parsed} -> {$name}));
 224       croak "use '/^[_a-zA-Z]\\S*\$/' for 'Scrap'-ids in template file '$filename' (wrong: '$name')." unless ($name =~ /^[_a-zA-Z]\S*$/);
 225
 226       $self -> {parsed} -> {$name} = $_ -> getFirstChild -> getData;
 227       $self -> {parsed} -> {$name} =~ s/^\s+|\s+$//g;}
 228
 229     return 1; # looks fine
 230   }
 231   else {
 232     # XML::DOM not available...
 233     # parse the template using both hands ;)
 234     #
 235
 236     my ($xml, $root, $template);
 237     local (*FILE, $/);
 238
 239     open FILE, "< $filename" or croak "error while reading template file '$filename': $!";
 240     $xml = <FILE>;
 241     close FILE or croak "error while closing template file '$filename' after reading: $!";
 242
 243     ($root, $template) = ($1, $2) if ($xml =~ m|(<Template\s+[^>"]*(?:"[^"]*"[^>"]*)*>)(.*)</Template\s*>|s);
 244     croak "error while parsing template file '$filename': missing root element 'Template'"
 245       unless (defined $root and defined $template);
 246
 247     # extract meta delimiters
 248     #
 249     $self -> {metaon}  = $1 if ($root =~ /\smetaon\s*=\s*"([^"]+)"/);
 250     $self -> {metaoff} = $1 if ($root =~ /\smetaoff\s*=\s*"([^"]+)"/);
 251
 252     croak "missing meta defintion(s) in template file '$filename'." unless ($self -> {metaon} and $self -> {metaoff});
 253
 254     # don't use any other entities than &quot; &apos; &lt; &gt; and &amp;
 255     # (while using non XML::DOM - version)
 256     #
 257     for ('metaon', 'metaoff') {
 258       $self -> {$_} =~ s/&quot;/"/g;  $self -> {$_} =~ s/&apos;/'/g;
 259       $self -> {$_} =~ s/&lt;/</g;    $self -> {$_} =~ s/&gt;/>/g;
 260       $self -> {$_} =~ s/&amp;/&/g;
 261     }
 262
 263     $self -> {parsed} = {};
 264     while ($template =~ m|<Scrap\s+(?:id\s*=\s*"([^"]+)")?\s*>\s*<!\[CDATA\[([^\]]*(?:\](?!\]>)[^\]]*)*)\]\]>\s*</Scrap\s*>|g) {
 265
 266       my ($name, $content) = ($1, $2);
 267
 268       croak "Element 'Scrap' requires attribute 'id' in template file '$filename'"
 269         unless (defined $name and length $name);
 270
 271       croak "double defined id '$name' in template file '$filename'"
 272         if (exists ($self -> {parsed} -> {$name}));
 273
 274       croak "use '/^[_a-zA-Z]\\S*\$/' for 'Scrap'-ids in template file '$filename' (wrong: '$name')"
 275         unless ($name =~ /^[_a-zA-Z]\S*$/);
 276
 277       $content =~ s/^\s+//; $content =~ s/\s+$//;
 278       $self -> {parsed} -> {$name} = $content;
 279     }
 280
 281     return 1; # looks fine
 282   }
 283
 284   return; # anything failed (??)
 285 }
 286
 287 ### sub parse_if ###############################################################
 288 #
 289 # parse conditional blocks
 290 #
 291 # Params: $scrap  - scalar reference of the template scrap
 292 #         $params - hash reference: values from the application
 293 #
 294 # Return: ~none~, ($$scrap will be modified)
 295 #
 296 sub parse_if {
 297   my $self = shift;
 298   my ($scrap, $params) = @_;
 299
 300   my $qmon  = quotemeta $self -> {metaon};
 301   my $qmoff = quotemeta $self -> {metaoff};
 302
 303   # the following regex is just not optimized,
 304   # but it works ;)
 305
 306   1 while ($$scrap =~ s {
 307     ($qmon\s*%(?:IF|ELSE)\s+.+?\s*$qmoff.*?) # skip this part
 308     (?=$qmon\s*%IF\s+.+?\s*$qmoff)           # if %IF or %ELSE are followed by %IF
 309
 310    |(                                        # $2 starts here
 311      $qmon\s*%IF\s+(.+?)\s*$qmoff            # %IF
 312      (.*?)                                   # $4
 313      (?:
 314        $qmon\s*%ENDIF\s*$qmoff               # followed by %ENDIF
 315       |                                      # or
 316        $qmon\s*%ELSE\s*$qmoff                # %ELSE...
 317        (.*?)                                 # $5
 318        $qmon\s*%ENDIF\s*$qmoff               # ...and ENDIF
 319      )
 320     )
 321   }
 322   { my $ret;
 323     if ($2) {
 324       my ($t3, $t4, $t5) = ($3, $4, $5);
 325
 326       for (split /\s+/,$t3) {
 327         next unless (
 328           exists($params->{$_})
 329           and defined ${$params->{$_}}
 330           and length ${$params->{$_}}
 331         );
 332
 333         $ret = $t4; last;
 334       }
 335
 336       $ret = $t5 || '' unless (defined $ret);
 337     }
 338     else {
 339       $ret=$1;
 340     }
 341
 342     $ret;
 343   }gsex);
 344
 345   return;
 346 }
 347
 348 # keeping 'require' happy
 349 1;
 350
 351 #
 352 #
 353 ### end of Template ############################################################