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);
  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 = new XML::DOM::Parser -> parsefile ($filename);
 145     my $template = $xml -> getElementsByTagName ('Template', 0) -> item (0);
 146
 147     # Metas bestimmen
 148     $self -> {metaon}  = $template -> getAttribute ('metaon');
 149     $self -> {metaoff} = $template -> getAttribute ('metaoff');
 150
 151     croak "missing meta defintion(s) in template file '$filename'." unless ($self -> {metaon} and $self -> {metaoff});
 152
 153     $self -> {parsed} = {};
 154     foreach ($template -> getElementsByTagName ('Scrap', 0)) {
 155       my $name = $_ -> getAttribute ('id');
 156
 157       croak "Element 'Scrap' requires attribute 'id' in template file '$filename'." unless (length ($name));
 158       croak "double defined id '$name' in template file '$filename'." if (exists ($self -> {parsed} -> {$name}));
 159       croak "use '/^[_a-zA-Z]\\S*\$/' for 'Scrap'-ids in template file '$filename' (wrong: '$name')." unless ($name =~ /^[_a-zA-Z]\S*$/);
 160
 161       $self -> {parsed} -> {$name} = $_ -> getFirstChild -> getData;
 162       $self -> {parsed} -> {$name} =~ s/^\s+|\s+$//g;}
 163
 164     return 1; # alles klar
 165   }
 166
 167   0;
 168 }
 169
 170 ################################
 171 # sub parse_if
 172 #
 173 # %IF - Anweisungen parsen
 174 ################################
 175
 176 sub parse_if {
 177   my $self = shift;
 178   my ($scrap,$params) = @_;
 179
 180   my $qmon  = quotemeta $self -> {metaon};
 181   my $qmoff = quotemeta $self -> {metaoff};
 182
 183   # der folgende Regex ist ein bisschen fies ...
 184   # ... aber er funktioniert :-)
 185   #
 186   # pfff - rekursive Strukturen iterativ parsen ist nicht wirklich witzig
 187   while ($$scrap=~s[ ($qmon\s*%(?:IF|ELSE)\s+.+?\s*$qmoff.*?) # Wenn IF oder ELSE von
 188                      (?=$qmon\s*%IF\s+.+?\s*$qmoff)           # IF gefolgt werden, soll
 189                                                               # dieses Stueck uebersprungen
 190                                                               # werden und erstmal mit der
 191                                                               # naechsten Ebene weitergemacht
 192                                                               # werden.
 193
 194                     |(                                        # hier beginnt $2
 195                       $qmon\s*%IF\s+(.+?)\s*$qmoff            # IF
 196                       (.*?)                                   # $4
 197                       (?:
 198                         $qmon\s*%ENDIF\s*$qmoff               # gefolgt von ENDIF
 199                        |                                      # oder
 200                         $qmon\s*%ELSE\s*$qmoff                # von ELSE... ($4 ELSE $5) $5 $6
 201                         (.*?)
 202                         $qmon\s*%ENDIF\s*$qmoff               # und ENDIF
 203                       )
 204                      )
 205                    ]
 206                    [my $ret;
 207                     if ($2) {
 208                       my ($t4,$t5,$t6) = ($4,$5,$6);
 209                       my $flag=0;
 210                       foreach (split /\s+/,$3) {
 211                         if (exists($params->{$_}) and length(${$params->{$_}})) {$ret = $t4; $flag=1;last;}}
 212                       $ret = $t5 unless ($flag);}
 213                     else {$ret=$1;}
 214                     $ret;
 215                    ]gosex) {};
 216
 217   return;
 218 }
 219
 220 # ====================================================
 221 # Modulinitialisierung
 222 # ====================================================
 223
 224 # making require happy
 225 1;
 226
 227 # ====================================================
 228 # end of Template
 229 # ====================================================