X-Git-Url: https://git.p6c8.net/selfforum.git/blobdiff_plain/e2e7aa7684b1d7b5c6824e04b4fd5368720817d0..920bb240f2bab1555b7a45cfae4f15d0ddb8df97:/selfforum-cgi/shared/Template.pm?ds=inline diff --git a/selfforum-cgi/shared/Template.pm b/selfforum-cgi/shared/Template.pm index d029493..16562c9 100644 --- a/selfforum-cgi/shared/Template.pm +++ b/selfforum-cgi/shared/Template.pm @@ -1,150 +1,229 @@ -# Template.pm +package Template; -# ==================================================== -# Autor: n.d.p. / 2001-01-06 -# lm : n.d.p. / 2001-01-25 -# ==================================================== -# Funktion: -# Ausfuellen von Templates -# ==================================================== +################################################################################ +# # +# File: shared/Template.pm # +# # +# Authors: André Malo , 2001-04-12 # +# Frank Schoenmann , 2001-06-04 # +# # +# Description: Handle XML based HTML-Templates # +# # +################################################################################ use strict; +use vars qw( + $xml_dom_used + $VERSION +); + +use Carp qw( + croak + confess +); + +BEGIN { + $xml_dom_used = eval q[ + local $SIG{__DIE__}; + use XML::DOM; + 1; + ]; +} -package Template; - -use CGI::Carp qw(croak); -use XML::DOM; +################################################################################ +# +# Version check +# +$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; -# ==================================================== -# Methoden -# ==================================================== -################################ -# sub new +### sub new #################################################################### +# +# constructor +# +# Params: ~none~ +# +# Return: Template object # -# Konstruktor -################################ - sub new { - my $instance=shift; - my $class=(ref($instance) or $instance); + my $instance = shift; - my $self = {}; - $self = bless $self,$class; + my $self = bless {} => ref($instance) || $instance; $self -> file (+shift); - # Rueckgabe + # return $self; } -################################ -# sub file +### sub file ################################################################### +# +# assign new template file to object +# parse the template file +# +# Params: $new - (optional) new template file +# +# Return: scalar - old filename or if there's no old filename given # -# Datei zuweisen und parsen -################################ - sub file { my $self = shift; - my $old = $self -> {file}; - my $new = shift; + my $new = shift; + my $old = $self -> {file}; $self -> {file} = $new if (defined $new); $self -> parse_file; + # return $old; } -################################ -# sub insert +### sub insert ################################################################# +# +# return the placeholder surrounded by meta delimiters +# +# Params: $name - name of placeholder +# +# Return: scalar - placeholder surrounded by meta delimiters # -# Bezeichner in Metazeichen -# eingeschlossen zurueckgeben -################################ - sub insert { - my $self=shift; - croak "no template file specified" unless (defined $self -> {file}); + my $self = shift; + my $name = shift; - my $name=shift; + croak "no template file specified" + unless (defined $self -> {file}); - # Rueckgabe + # return $self -> {metaon} . $name . $self -> {metaoff}; } -################################ -# sub list +### sub list ################################################################### +# +# fill in a complete list +# +# Params: $name - name of the atomic scrap +# $array - list of hashes (same strcuture like the hash used by 'scrap') +# +# Return: scalar reference - filled in list # -# komplette Liste einsetzen -################################ - sub list { - my $self=shift; - my $name=shift; + my $self = shift; + my $name = shift; - croak "no template file specified" unless (defined $self->{file}); + croak "no template file specified" + unless (defined $self -> {file}); - my $list = join '', map { ${ $self -> scrap ($name, $_) } } @{ +shift }; +# no warnings 'uninitialized'; + my $list = join '' => map { ${ $self -> scrap ($name, $_) } } @{ +shift }; - # Rueckgabe + # return \$list; } -################################ -# sub scrap +### sub scrap ################################################################## +# +# fill in a template scrap +# +# Params: $name name of the scrap +# ... +# $no_nl 1 - remove newlines (\n) +# 0 - do no such thing +# +# Return: scalar reference - filled in scrap # -# Schnipsel ausfuellen -################################ - sub scrap { - my $self=shift; - my $name=shift; + my $self = shift; + my $name = shift; - croak "no template file specified" unless (defined $self->{file}); + my $no_nl; + if (!ref $_[$#_]) { + $no_nl = pop @_; + } - my %params; + croak "no template file specified" + unless (defined $self -> {file}); - # Parameter holen - # Als Values werden nur die Referenzen gespeichert - %params = map { my $ref = $_; map { ($_ => ( (ref ($ref -> {$_} ) )?$ref -> {$_}: \($ref -> {$_} ) ) ) } keys %$ref } splice @_; + return \'' unless (defined $name and defined ($self -> {parsed} -> {$name})); - # und einsetzen - my $scrap=$self->{parsed}->{$name}; - my $qmon=quotemeta $self->{metaon}; - my $qmoff=quotemeta $self->{metaoff}; + # fetch parameters + # (and normalize - save only the references in %params) + # + my %params; + %params = map { + my $ref = $_; + map { + ($_ => ( + ref ($ref -> {$_}) + ? (defined ${$ref -> {$_}} ? $ref -> {$_} : \'') + : \(defined $ref -> {$_} ? $ref -> {$_} : '')) + ) + } keys %$ref + } splice @_; + + # fill in... + # + my $scrap = $self -> {parsed} -> {$name}; + my $qmon = quotemeta $self -> {metaon}; + my $qmoff = quotemeta $self -> {metaoff}; - # und zwar solange, bis nichts mehr da ist - while ($scrap =~ s<$qmon\s*([_a-zA-Z]\S*)\s*$qmoff>[ - my $x=''; - if ( exists ( $params{$1} ) ) { $x = ${$params{$1}} } - elsif (exists ( $self -> {parsed} -> {$1} ) ) { $x = $self -> {parsed} -> {$1}} - $x;]geo ){}; + # ...until we've replaced all placeholders + # + 1 while ( + $scrap =~ s + < + $qmon \s* + ([_a-zA-Z] \S*) + \s* $qmoff + > + [ (exists ( $params{$1} ) ) + ? ${$params{$1}} + : ( exists ( $self -> {parsed} -> {$1} ) + ? $self -> {parsed} -> {$1} + : '' + ); + ]gex + ); + + # parse conditional blocks + # + $self -> parse_if ( + \$scrap, + \%params + ); - $self -> parse_if (\$scrap,\%params); + # remove newlines + # + $scrap =~ s/\015\012|\015|\012//g if ($no_nl); - # Rueckgabe + # return \$scrap; } -# ==================================================== -# Private Funktionen/Methoden -# ==================================================== - -################################ -# sub parse_file +### sub parse_file ############################################################# +# +# read in and parse template file +# +# Params: ~none~ +# +# Return: Status Code (Boolean) # -# Template einlesen & parsen -################################ - sub parse_file { my $self = shift; + my $filename = $self -> {file}; + + if ($xml_dom_used) { + + # parse template using XML::DOM + # + my $xml = eval { + local $SIG{__DIE__}; + new XML::DOM::Parser -> parsefile ($filename); + }; + croak "error while parsing template file '$filename': $@" if ($@); - if (-f $self -> {file}) { - my $filename = $self -> {file}; - my $xml = new XML::DOM::Parser -> parsefile ($filename); my $template = $xml -> getElementsByTagName ('Template', 0) -> item (0); - # Metas bestimmen + # extract meta delimiters + # $self -> {metaon} = $template -> getAttribute ('metaon'); $self -> {metaoff} = $template -> getAttribute ('metaoff'); @@ -161,69 +240,128 @@ sub parse_file { $self -> {parsed} -> {$name} = $_ -> getFirstChild -> getData; $self -> {parsed} -> {$name} =~ s/^\s+|\s+$//g;} - return 1; # alles klar + return 1; # looks fine } + else { + # XML::DOM not available... + # parse the template using both hands ;) + # + + my ($xml, $root, $template); + local (*FILE, $/); + + open FILE, "< $filename" or croak "error while reading template file '$filename': $!"; + $xml = ; + close FILE or croak "error while closing template file '$filename' after reading: $!"; + + ($root, $template) = ($1, $2) if ($xml =~ m|("]*(?:"[^"]*"[^>"]*)*>)(.*)|s); + croak "error while parsing template file '$filename': missing root element 'Template'" + unless (defined $root and defined $template); + + # extract meta delimiters + # + $self -> {metaon} = $1 if ($root =~ /\smetaon\s*=\s*"([^"]+)"/); + $self -> {metaoff} = $1 if ($root =~ /\smetaoff\s*=\s*"([^"]+)"/); + + croak "missing meta defintion(s) in template file '$filename'." unless ($self -> {metaon} and $self -> {metaoff}); + + # don't use any other entities than " ' < > and & + # (while using non XML::DOM - version) + # + for ('metaon', 'metaoff') { + $self -> {$_} =~ s/"/"/g; $self -> {$_} =~ s/'/'/g; + $self -> {$_} =~ s/</ {$_} =~ s/>/>/g; + $self -> {$_} =~ s/&/&/g; + } + + $self -> {parsed} = {}; + while ($template =~ m|\s*)[^\]]*)*)\]\]>\s*|g) { + + my ($name, $content) = ($1, $2); + + croak "Element 'Scrap' requires attribute 'id' in template file '$filename'" + unless (defined $name and length $name); - 0; + croak "double defined id '$name' in template file '$filename'" + if (exists ($self -> {parsed} -> {$name})); + + croak "use '/^[_a-zA-Z]\\S*\$/' for 'Scrap'-ids in template file '$filename' (wrong: '$name')" + unless ($name =~ /^[_a-zA-Z]\S*$/); + + $content =~ s/^\s+//; $content =~ s/\s+$//; + $self -> {parsed} -> {$name} = $content; + } + + return 1; # looks fine + } + + return; # anything failed (??) } -################################ -# sub parse_if +### sub parse_if ############################################################### +# +# parse conditional blocks +# +# Params: $scrap - scalar reference of the template scrap +# $params - hash reference: values from the application +# +# Return: ~none~, ($$scrap will be modified) # -# %IF - Anweisungen parsen -################################ - sub parse_if { my $self = shift; - my ($scrap,$params) = @_; + my ($scrap, $params) = @_; my $qmon = quotemeta $self -> {metaon}; my $qmoff = quotemeta $self -> {metaoff}; - # der folgende Regex ist ein bisschen fies ... - # ... aber er funktioniert :-) - # - # pfff - rekursive Strukturen iterativ parsen ist nicht wirklich witzig - while ($$scrap=~s[ ($qmon\s*%(?:IF|ELSE)\s+.+?\s*$qmoff.*?) # Wenn IF oder ELSE von - (?=$qmon\s*%IF\s+.+?\s*$qmoff) # IF gefolgt werden, soll - # dieses Stueck uebersprungen - # werden und erstmal mit der - # naechsten Ebene weitergemacht - # werden. - - |( # hier beginnt $2 - $qmon\s*%IF\s+(.+?)\s*$qmoff # IF - (.*?) # $4 - (?: - $qmon\s*%ENDIF\s*$qmoff # gefolgt von ENDIF - | # oder - $qmon\s*%ELSE\s*$qmoff # von ELSE... ($4 ELSE $5) $5 $6 - (.*?) - $qmon\s*%ENDIF\s*$qmoff # und ENDIF - ) - ) - ] - [my $ret; - if ($2) { - my ($t4,$t5,$t6) = ($4,$5,$6); - my $flag=0; - foreach (split /\s+/,$3) { - if (exists($params->{$_}) and length(${$params->{$_}})) {$ret = $t4; $flag=1;last;}} - $ret = $t5 unless ($flag);} - else {$ret=$1;} - $ret; - ]gosex) {}; + # the following regex is just not optimized, + # but it works ;) + + 1 while ($$scrap =~ s { + ($qmon\s*%(?:IF|ELSE)\s+.+?\s*$qmoff.*?) # skip this part + (?=$qmon\s*%IF\s+.+?\s*$qmoff) # if %IF or %ELSE are followed by %IF + + |( # $2 starts here + $qmon\s*%IF\s+(.+?)\s*$qmoff # %IF + (.*?) # $4 + (?: + $qmon\s*%ENDIF\s*$qmoff # followed by %ENDIF + | # or + $qmon\s*%ELSE\s*$qmoff # %ELSE... + (.*?) # $5 + $qmon\s*%ENDIF\s*$qmoff # ...and ENDIF + ) + ) + } + { my $ret; + if ($2) { + my ($t3, $t4, $t5) = ($3, $4, $5); + + for (split /\s+/,$t3) { + next unless ( + exists($params->{$_}) + and defined ${$params->{$_}} + and length ${$params->{$_}} + ); + + $ret = $t4; last; + } + + $ret = $t5 || '' unless (defined $ret); + } + else { + $ret=$1; + } + + $ret; + }gsex); return; } -# ==================================================== -# Modulinitialisierung -# ==================================================== - -# making require happy +# keep 'require' happy 1; -# ==================================================== -# end of Template -# ==================================================== \ No newline at end of file +# +# +### end of Template ############################################################ \ No newline at end of file