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