selfforum-cgi/shared/Template.pm

   1 # Template.pm
   2
   3 # ====================================================
   4 # Autor: n.d.p. / 2001-01-06
   5 # lm   : n.d.p. / 2001-01-25
   6 # ====================================================
   7 # Funktion:
   8 #      Ausfuellen von Templates
   9 # ====================================================
  10
  11 use strict;
  12
  13 package Template;
  14
  15 use autouse 'Carp' => qw(croak confess);
  16 use XML::DOM;
  17
  18 # ====================================================
  19 # Methoden
  20 # ====================================================
  21
  22 ################################
  23 # sub new
  24 #
  25 # Konstruktor
  26 ################################
  27
  28 sub new {
  29   my $instance=shift;
  30   my $class=(ref($instance) or $instance);
  31
  32   my $self = {};
  33   $self = bless $self,$class;
  34
  35   $self -> file (+shift);
  36
  37   # Rueckgabe
  38   $self;
  39 }
  40
  41 ################################
  42 # sub file
  43 #
  44 # Datei zuweisen und parsen
  45 ################################
  46
  47 sub file {
  48   my $self = shift;
  49   my $old = $self -> {file};
  50   my $new = shift;
  51
  52   $self -> {file} = $new if (defined $new);
  53   $self -> parse_file;
  54
  55   $old;
  56 }
  57
  58 ################################
  59 # sub insert
  60 #
  61 # Bezeichner in Metazeichen
  62 # eingeschlossen zurueckgeben
  63 ################################
  64
  65 sub insert {
  66   my $self=shift;
  67   croak "no template file specified" unless (defined $self -> {file});
  68
  69   my $name=shift;
  70
  71   # Rueckgabe
  72   $self -> {metaon} . $name . $self -> {metaoff};
  73 }
  74
  75 ################################
  76 # sub list
  77 #
  78 # komplette Liste einsetzen
  79 ################################
  80
  81 sub list {
  82   my $self=shift;
  83   my $name=shift;
  84
  85   croak "no template file specified" unless (defined $self->{file});
  86
  87   my $list = join '', map { ${ $self -> scrap ($name, $_) } } @{ +shift };
  88
  89   # Rueckgabe
  90   \$list;
  91 }
  92
  93 ################################
  94 # sub scrap
  95 #
  96 # Schnipsel ausfuellen
  97 ################################
  98
  99 sub scrap {
 100   my $self=shift;
 101   my $name=shift;
 102
 103   croak "no template file specified" unless (defined $self->{file});
 104
 105   my %params;
 106
 107   # Parameter holen
 108   # Als Values werden nur die Referenzen gespeichert
 109   %params = map { my $ref = $_; map { ($_ => ( (ref ($ref -> {$_} ) )?$ref -> {$_}: \($ref -> {$_} ) ) ) } keys %$ref } splice @_;
 110
 111   # und einsetzen
 112   my $scrap=$self->{parsed}->{$name};
 113   my $qmon=quotemeta $self->{metaon};
 114   my $qmoff=quotemeta $self->{metaoff};
 115
 116   # und zwar solange, bis nichts mehr da ist
 117   while ($scrap =~ s<$qmon\s*([_a-zA-Z]\S*)\s*$qmoff>[
 118     my $x='';
 119     if ( exists ( $params{$1} ) ) { $x = ${$params{$1}} }
 120     elsif (exists ( $self -> {parsed} -> {$1} ) ) { $x = $self -> {parsed} -> {$1}}
 121     $x;]geo ){};
 122
 123   $self -> parse_if (\$scrap,\%params);
 124
 125   # Rueckgabe
 126   \$scrap;
 127 }
 128
 129 # ====================================================
 130 # Private Funktionen/Methoden
 131 # ====================================================
 132
 133 ################################
 134 # sub parse_file
 135 #
 136 # Template einlesen & parsen
 137 ################################
 138
 139 sub parse_file {
 140   my $self = shift;
 141
 142   if (-f $self -> {file}) {
 143     my $filename = $self -> {file};
 144     my $xml = eval {
 145       local $SIG{__DIE__};
 146       new XML::DOM::Parser -> parsefile ($filename);
 147     };
 148     croak "error in template file '$filename': $@" if ($@);
 149
 150     my $template = $xml -> getElementsByTagName ('Template', 0) -> item (0);
 151
 152     # Metas bestimmen
 153     $self -> {metaon}  = $template -> getAttribute ('metaon');
 154     $self -> {metaoff} = $template -> getAttribute ('metaoff');
 155
 156     croak "missing meta defintion(s) in template file '$filename'." unless ($self -> {metaon} and $self -> {metaoff});
 157
 158     $self -> {parsed} = {};
 159     foreach ($template -> getElementsByTagName ('Scrap', 0)) {
 160       my $name = $_ -> getAttribute ('id');
 161
 162       croak "Element 'Scrap' requires attribute 'id' in template file '$filename'." unless (length ($name));
 163       croak "double defined id '$name' in template file '$filename'." if (exists ($self -> {parsed} -> {$name}));
 164       croak "use '/^[_a-zA-Z]\\S*\$/' for 'Scrap'-ids in template file '$filename' (wrong: '$name')." unless ($name =~ /^[_a-zA-Z]\S*$/);
 165
 166       $self -> {parsed} -> {$name} = $_ -> getFirstChild -> getData;
 167       $self -> {parsed} -> {$name} =~ s/^\s+|\s+$//g;}
 168
 169     return 1; # alles klar
 170   }
 171
 172   0;
 173 }
 174
 175 ################################
 176 # sub parse_if
 177 #
 178 # %IF - Anweisungen parsen
 179 ################################
 180
 181 sub parse_if {
 182   my $self = shift;
 183   my ($scrap, $params) = @_;
 184
 185   my $qmon  = quotemeta $self -> {metaon};
 186   my $qmoff = quotemeta $self -> {metaoff};
 187
 188   # der folgende Regex ist ein bisschen fies ...
 189   # ... aber er funktioniert :-)
 190   #
 191   # pfff - rekursive Strukturen iterativ parsen ist nicht wirklich witzig
 192   #
 193
 194   1 while ($$scrap =~ s {
 195     ($qmon\s*%(?:IF|ELSE)\s+.+?\s*$qmoff.*?) # Wenn IF oder ELSE von
 196     (?=$qmon\s*%IF\s+.+?\s*$qmoff)           # IF gefolgt werden, soll
 197                                              # dieses Stueck uebersprungen
 198                                              # werden und erstmal mit der
 199                                              # naechsten Ebene weitergemacht
 200                                              # werden.
 201
 202    |(                                        # hier beginnt $2
 203      $qmon\s*%IF\s+(.+?)\s*$qmoff            # IF
 204      (.*?)                                   # $4
 205      (?:
 206        $qmon\s*%ENDIF\s*$qmoff               # gefolgt von ENDIF
 207       |                                      # oder
 208        $qmon\s*%ELSE\s*$qmoff                # von ELSE... ($4 ELSE $5)
 209        (.*?)
 210        $qmon\s*%ENDIF\s*$qmoff               # und ENDIF
 211      )
 212     )
 213   }
 214   { my $ret;
 215     if ($2) {
 216       my ($t3, $t4, $t5) = ($3, $4, $5);
 217
 218       for (split /\s+/,$t3) {
 219         next unless (
 220           exists($params->{$_})
 221           and length ${$params->{$_}}
 222         );
 223
 224         $ret = $t4; last;
 225       }
 226
 227       $ret = $t5 || '' unless (defined $ret);
 228     }
 229     else {
 230       $ret=$1;
 231     }
 232
 233     $ret;
 234   }gosex);
 235
 236   return;
 237 }
 238
 239 # keep require happy
 240 1;
 241
 242 #
 243 #
 244 ### end of Template ############################################################