Template.pm, Template/Posting.pm, Encode/Posting.pm: fixed some bugs (that produced...

Posting/_lib.pm: no really changes

diff --git a/selfforum-cgi/shared/Encode/Posting.pm b/selfforum-cgi/shared/Encode/Posting.pm
index 76463bc936ec1dd40738a2907d65cb1e65ceb350..80c414bfe3fa188dd05b2726c211bb6abd0703b5 100644 (file)
--- a/selfforum-cgi/shared/Encode/Posting.pm
+++ b/selfforum-cgi/shared/Encode/Posting.pm
@@ -151,7 +151,7 @@ sub answer_field ($$) {
 
   my $qchar = $params -> {quoteChars};
 
 
   my $qchar = $params -> {quoteChars};
 

-  $area =~ s/(?:^|(<br>))(?!<br>)/$1\177/g if ($params -> {quoteArea}); # Antwortfeld quoten?!
+  $area =~ s/(?:^|(<br>))(?!<br>)/$1 || '' . "\177"/eg if ($params -> {quoteArea}); # Antwortfeld quoten?!

   $area =~ s/\177/$qchar/g; # normalisierte Quotes jedenfalls in Chars umsetzen
 
   # HTML-Zeug zurueckuebersetzen
   $area =~ s/\177/$qchar/g; # normalisierte Quotes jedenfalls in Chars umsetzen
 
   # HTML-Zeug zurueckuebersetzen


@@ -198,7 +198,7 @@ sub message_field ($$) {
 
     foreach $line (split (/<br>/,$posting)) { # Zeilenweise gucken,
       ($q) = ($line =~ /^(\177+)/g);          # wieviele
 
     foreach $line (split (/<br>/,$posting)) { # Zeilenweise gucken,
       ($q) = ($line =~ /^(\177+)/g);          # wieviele

-      $level = length ($q);                   # Quotingchars am Anfang stehen
+      $level = length ($q or '');             # Quotingchars am Anfang stehen

       if ($level != $last_level) {            # wenn sich was verandert...
                                               # ... dann TU ETWAS!
 
       if ($level != $last_level) {            # wenn sich was verandert...
                                               # ... dann TU ETWAS!
 

diff --git a/selfforum-cgi/shared/Template.pm b/selfforum-cgi/shared/Template.pm
index a55f79e3b73da734d184294b7a0930f7c47956bf..e74d1d24dcad70a7b2c8ba9b64bd0935fd3eafcb 100644 (file)
--- a/selfforum-cgi/shared/Template.pm
+++ b/selfforum-cgi/shared/Template.pm
@@ -12,7 +12,7 @@ use strict;
 
 package Template;
 
 
 package Template;
 

-use autouse 'Carp' => qw(croak);
+use autouse 'Carp' => qw(croak confess);

 use XML::DOM;
 
 # ====================================================
 use XML::DOM;
 
 # ====================================================


@@ -141,7 +141,12 @@ sub parse_file {
 
   if (-f $self -> {file}) {
     my $filename = $self -> {file};
 
   if (-f $self -> {file}) {
     my $filename = $self -> {file};

-    my $xml = new XML::DOM::Parser -> parsefile ($filename);
+    my $xml = eval {
+      local $SIG{__DIE__};
+      new XML::DOM::Parser -> parsefile ($filename);
+    };
+    croak "error in template file '$filename': $@" if ($@);
+

     my $template = $xml -> getElementsByTagName ('Template', 0) -> item (0);
 
     # Metas bestimmen
     my $template = $xml -> getElementsByTagName ('Template', 0) -> item (0);
 
     # Metas bestimmen


@@ -175,7 +180,7 @@ sub parse_file {
 
 sub parse_if {
   my $self = shift;
 
 sub parse_if {
   my $self = shift;

-  my ($scrap,$params) = @_;
+  my ($scrap, $params) = @_;

 
   my $qmon  = quotemeta $self -> {metaon};
   my $qmoff = quotemeta $self -> {metaoff};
 
   my $qmon  = quotemeta $self -> {metaon};
   my $qmoff = quotemeta $self -> {metaoff};


@@ -184,46 +189,56 @@ sub parse_if {
   # ... aber er funktioniert :-)
   #
   # pfff - rekursive Strukturen iterativ parsen ist nicht wirklich witzig
   # ... 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) {};
+  #
+
+  1 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)
+       (.*?)
+       $qmon\s*%ENDIF\s*$qmoff               # und ENDIF
+     )
+    )
+  }
+  { my $ret;
+    if ($2) {
+      my ($t3, $t4, $t5) = ($3, $4, $5);
+
+      for (split /\s+/,$t3) {
+        next unless (
+          exists($params->{$_})
+          and length ${$params->{$_}}
+        );
+
+        $ret = $t4; last;
+      }
+
+      $ret = $t5 || '' unless (defined $ret);
+    }
+    else {
+      $ret=$1;
+    }
+
+    $ret;
+  }gosex);

 
   return;
 }
 
 
   return;
 }
 

-# ====================================================
-# Modulinitialisierung
-# ====================================================
-
-# making require happy
+# keep require happy

 1;
 
 1;
 

-# ====================================================
-# end of Template
-# ====================================================
\ No newline at end of file
+#
+#
+### end of Template ############################################################

diff --git a/selfforum-cgi/shared/Template/Posting.pm b/selfforum-cgi/shared/Template/Posting.pm
index 441178de243a4ad198b702876dbd29513e17ba6b..5081a1a9a8b182e7ace6c793bfac89d73775b606 100644 (file)
--- a/selfforum-cgi/shared/Template/Posting.pm
+++ b/selfforum-cgi/shared/Template/Posting.pm
@@ -1,22 +1,29 @@
-# Template/Posting.pm
+package Template::Posting;

 
 

-# ====================================================
-# Autor: n.d.p. / 2001-01-14
-# lm   : n.d.p. / 2001-01-14
-# ====================================================
-# Funktion:
-#      HTML-Darstellung eines Postings
-# ====================================================
+################################################################################
+#                                                                              #
+# File:        shared/Template/Posting.pm                                      #
+#                                                                              #
+# Authors:     Andre Malo       <nd@o3media.de>, 2001-04-01                    #
+#                                                                              #
+# Description: show HTML formatted posting                                     #
+#                                                                              #
+################################################################################

 
 use strict;
 
 
 use strict;
 

-package Template::Posting;
-

 use Encode::Posting;
 use Encode::Plain; $Encode::Plain::utf8 = 1;
 use Id;
 use Encode::Posting;
 use Encode::Plain; $Encode::Plain::utf8 = 1;
 use Id;

-use Lock qw(:WRITE);
-use Posting::_lib qw(get_message_node get_message_header get_message_body parse_single_thread hr_time);
+use Lock qw(:READ);
+use Posting::_lib qw(
+  get_message_node
+  get_message_header
+  get_message_body
+  parse_single_thread
+  parse_xml_file
+  hr_time
+);

 use Template;
 use Template::_conf;
 use Template::_query;
 use Template;
 use Template::_conf;
 use Template::_query;


@@ -24,29 +31,37 @@ use Template::_thread;
 
 use XML::DOM;
 
 
 use XML::DOM;
 

-# ====================================================
-# Funktionsexport
-# ====================================================
-
+################################################################################
+#
+# Export
+#

 use base qw(Exporter);
 use base qw(Exporter);

-@Template::Posting::EXPORT = qw(print_posting_as_HTML message_as_HTML);
+@Template::Posting::EXPORT = qw(
+  print_posting_as_HTML
+  message_as_HTML
+);

 
 

-################################
-# sub print_posting_as_HTML
+### sub print_posting_as_HTML ($$$) ############################################
+#
+# print HTML formatted Posting to STDOUT
+#
+# Params: $threadpath - /path/to/thread_files
+#         $tempfile   - template file
+#         $param      - Hash-Reference (see doc for details)
+#
+# Return: -none-

 #
 #

-# HTML erzeugen
-################################
-

 sub print_posting_as_HTML ($$$) {
   my ($threadpath, $tempfile, $param) = @_;
 
   my $template = new Template $tempfile;
 
   # Datei sperren... (eigentlich)
 sub print_posting_as_HTML ($$$) {
   my ($threadpath, $tempfile, $param) = @_;
 
   my $template = new Template $tempfile;
 
   # Datei sperren... (eigentlich)

-  my $view = get_view_params ({adminDefault => $param -> {adminDefault}
-                              });
+  my $view = get_view_params ({
+    adminDefault => $param -> {adminDefault}
+  });

 
 

-  my $xml=new XML::DOM::Parser -> parsefile ($threadpath.'t'.$param -> {thread}.'.xml');
+  my $xml = parse_xml_file ($threadpath.'t'.$param -> {thread}.'.xml');

 
   my ($mnode, $tnode) = get_message_node ($xml, 't'.$param -> {thread}, 'm'.$param -> {posting});
   my $pnode = $mnode -> getParentNode;
 
   my ($mnode, $tnode) = get_message_node ($xml, 't'.$param -> {thread}, 'm'.$param -> {posting});
   my $pnode = $mnode -> getParentNode;


@@ -60,89 +75,120 @@ sub print_posting_as_HTML ($$$) {
 
   my $body = get_message_body ($xml, 'm'.$param -> {posting});
 
 
   my $body = get_message_body ($xml, 'm'.$param -> {posting});
 

-  my $text = message_field ($body,
-                           {quoteChars => plain($view -> {quoteChars}),
-                            quoting    => 1,
-                            startCite  => ${$template -> scrap ($assign -> {startCite})},
-                            endCite    => ${$template -> scrap ($assign -> {endCite})}
-                           });
-
-  my $area = answer_field ($body,
-                          {quoteArea  => 1,
-                           quoteChars => plain($view -> {quoteChars}),
-                           messages   => $param -> {messages}
-                          });
+  my $text = message_field (
+    $body,
+    { quoteChars => plain($view -> {quoteChars}),
+      quoting    => 1,
+      startCite  => ${$template -> scrap ($assign -> {startCite})},
+      endCite    => ${$template -> scrap ($assign -> {endCite})}
+    }
+  );
+
+  my $area = answer_field (
+    $body,
+    { quoteArea  => 1,
+      quoteChars => plain($view -> {quoteChars}),
+      messages   => $param -> {messages}
+    }
+  );

 
   my $pars = {};
 
 
   my $pars = {};
 

-  for (qw(posterBody uniqueID followUp quoteChar userID posterName posterEmail posterURL posterImage)) {
-    $pars -> {$formdata -> {$_} -> {assign} -> {name}} = plain($formdata -> {$_} -> {name});}
+  $pars -> {$formdata -> {$_} -> {assign} -> {name}} = plain($formdata -> {$_} -> {name})
+    for (qw(
+      posterBody
+      uniqueID
+      followUp
+      quoteChar
+      userID
+      posterName
+      posterEmail
+      posterURL
+      posterImage
+      ));

 
   my $cgi = $param -> {cgi};
 
 
   my $cgi = $param -> {cgi};
 

-  my $tpar = {thread   => $param -> {thread},
-              template => $param -> {tree},
-              start    => $param -> {posting},
-              cgi      => $cgi};
-
-  my $plink = %$pheader?(query_string ({$cgi -> {thread} => $param -> {thread}, $cgi -> {posting} => ($pnode -> getAttribute ('id') =~ /(\d+)/)[0]})):'';
-
-  print ${$template -> scrap ($assign->{mainDoc},
-                             {$assign->{name}                            => plain($header->{name}),
-                              $assign->{email}                           => plain($header->{email}),
-                              $assign->{home}                            => plain($header->{home}),
-                              $assign->{image}                           => plain($header->{image}),
-                              $assign->{time}                            => plain(hr_time($header->{time})),
-                              $assign->{message}                         => $text,
-                              $assign->{messageTitle}                    => plain($header->{subject}),
-                              $assign->{parentTitle}                     => plain($pheader->{subject}),
-                              $assign->{messageCat}                      => plain($header->{category}),
-                              $assign->{parentCat}                       => plain($pheader->{category}),
-                              $assign->{parentName}                      => plain($pheader->{name}),
-                              $assign->{parentLink}                      => $plink,
-                              $assign->{parentTime}                      => plain(hr_time($pheader->{time})),
-                              $param->{tree}->{main}                     => html_thread ($msg, $template, $tpar),
-                              $formact->{post}->{assign}                 => $formact->{post}->{url},
-                              $formact->{vote}->{assign}                 => $formact->{vote}->{url},
-                              $formdata->{posterBody}->{assign}->{value} => $area,
-                              $formdata->{uniqueID}  ->{assign}->{value} => plain(unique_id),
-                              $formdata->{followUp}  ->{assign}->{value} => plain($param -> {thread}.';'.$param -> {posting}),
-                              $formdata->{quoteChar} ->{assign}->{value} => "&#255;".plain($view -> {quoteChars}),
-                              $formdata->{userID}    ->{assign}->{value} => '',
-                              }, $pars)};
-
+  my $tpar = {
+    thread   => $param -> {thread},
+    template => $param -> {tree},
+    start    => $param -> {posting},
+    cgi      => $cgi
+  };
+
+  my $parent_pars;
+
+  $parent_pars = {
+    $assign->{parentTitle} => plain($pheader->{subject}),
+    $assign->{parentCat}   => plain($pheader->{category}),
+    $assign->{parentName}  => plain($pheader->{name}),
+    $assign->{parentTime}  => plain(hr_time($pheader->{time})),
+    $assign->{parentLink}  => query_string (
+      { $cgi -> {thread} => $param -> {thread},
+        $cgi -> {posting} => ($pnode -> getAttribute ('id') =~ /(\d+)/)[0]
+      })
+  } if (%$pheader);
+
+  print ${$template -> scrap (
+    $assign->{mainDoc},
+    { $assign->{name}                            => plain($header->{name}),
+      $assign->{email}                           => plain($header->{email}),
+      $assign->{home}                            => plain($header->{home}),
+      $assign->{image}                           => plain($header->{image}),
+      $assign->{time}                            => plain(hr_time($header->{time})),
+      $assign->{message}                         => $text,
+      $assign->{messageTitle}                    => plain($header->{subject}),
+      $assign->{messageCat}                      => plain($header->{category}),
+      $param->{tree}->{main}                     => html_thread ($msg, $template, $tpar),
+      $formact->{post}->{assign}                 => $formact->{post}->{url},
+      $formact->{vote}->{assign}                 => $formact->{vote}->{url},
+      $formdata->{posterBody}->{assign}->{value} => $area,
+      $formdata->{uniqueID}  ->{assign}->{value} => plain(unique_id),
+      $formdata->{followUp}  ->{assign}->{value} => plain($param -> {thread}.';'.$param -> {posting}),
+      $formdata->{quoteChar} ->{assign}->{value} => "&#255;".plain($view -> {quoteChars}),
+      $formdata->{userID}    ->{assign}->{value} => ''
+    },
+    $pars,
+    $parent_pars
+  )};
+
+  return;

 }
 
 }
 

-################################
-# sub message_as_HTML
+### sub message_as_HTML ($$$) ##################################################
+#
+# create HTML String for the Messagetext
+#
+# Params: $xml      - XML::DOM::Document object
+#         $template - Template object
+#         $param    - Hash reference
+#                     (assign, posting, quoteChars, quoting)
+#
+# Return: HTML String

 #
 #

-# HTML erzeugen
-################################
-

 sub message_as_HTML ($$$) {
   my ($xml, $template, $param) = @_;
 
   my $assign = $param -> {assign};
   my $body = get_message_body ($xml, $param -> {posting});
 
 sub message_as_HTML ($$$) {
   my ($xml, $template, $param) = @_;
 
   my $assign = $param -> {assign};
   my $body = get_message_body ($xml, $param -> {posting});
 

-  my $text = message_field ($body,
-                           {quoteChars => '&raquo;&raquo; ',
-                            quoting    => 1,
-                            startCite  => ${$template -> scrap ($assign -> {startCite})},
-                            endCite    => ${$template -> scrap ($assign -> {endCite})}
-                           });
+  my $text = message_field (
+    $body,
+    { quoteChars => plain ($param -> {quoteChars}),
+      quoting    => $param -> {quoting},
+      startCite  => ${$template -> scrap ($assign -> {startCite})},
+      endCite    => ${$template -> scrap ($assign -> {endCite})}
+    }
+  );

 
 

-  # Rueckgabe
+  # return

   $text;
 }
 
   $text;
 }
 

-# ====================================================
-# Modulinitialisierung
-# ====================================================
-
-# making require happy
+# keep require happy

 1;
 
 1;
 

-# ====================================================
-# end of Template::Posting
-# ====================================================
\ No newline at end of file
+#
+#
+### end of Template::Posting ###################################################
+