improved the behavior of get_all_threads and create_forum_xml_string

[selfforum.git] / selfforum-cgi / shared / Posting / _lib.pm

diff --git a/selfforum-cgi/shared/Posting/_lib.pm b/selfforum-cgi/shared/Posting/_lib.pm
index 4ca15145af43edb19ccbe1afdb6f593b54b2f61e..83439c5210dfd5622930f1c54181d4535cdc7e43 100644 (file)
--- a/selfforum-cgi/shared/Posting/_lib.pm
+++ b/selfforum-cgi/shared/Posting/_lib.pm
@@ -4,8 +4,8 @@ package Posting::_lib;
 #                                                                              #
 # File:        shared/Posting/_lib.pm                                          #
 #                                                                              #
-# Authors:     André Malo <nd@o3media.de>, 2001-06-11                          #
-#              Frank Schoenmann <fs@tower.de>, 2001-06-04                      #
+# Authors:     André Malo <nd@o3media.de>                                      #
+#              Frank Schönmann <fs@tower.de>                                   #
 #                                                                              #
 # Description: Message access interface, time format routines                  #
 #                                                                              #
@@ -14,19 +14,22 @@ package Posting::_lib;
 use strict;
 use vars qw(
   @EXPORT_OK
-  $VERSION
 );
 
 use Encode::Plain; $Encode::Plain::utf8 = 1;
 
-use Time::German;
+use Time::German qw(localtime);
 use XML::DOM;
 
 ################################################################################
 #
 # Version check
 #
-$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+# last modified:
+#    $Date$ (GMT)
+# by $Author$
+#
+sub VERSION {(q$Revision$ =~ /([\d.]+)\s*$/)[0] or '0.0'}
 
 ################################################################################
 #
@@ -37,6 +40,8 @@ use constant SORT_DESCENT => 1;
 use constant KEEP_DELETED => 1;
 use constant KILL_DELETED => 0;
 
+use constant FORUM_DTD => 'http://selfforum.sourceforge.net/dtd/forum.dtd';
+
 use base qw(Exporter);
 @EXPORT_OK = qw(
   get_message_header
@@ -132,7 +137,7 @@ sub create_message ($$) {
 # create a XML::DOM::Document object of a thread containing one posting
 #
 # Params: hash reference
-#         (dtd, thread, msg, body, ip, name, email, home,
+#         (thread, msg, body, ip, name, email, home,
 #          image, category, subject, time)
 #
 # Return: XML::DOM::Document object
@@ -153,7 +158,7 @@ sub create_new_thread ($) {
 
   # set doctype
   #
-  my $dtd = $xml -> createDocumentType ('Forum' => $par -> {dtd});
+  my $dtd = $xml -> createDocumentType ('Forum' => FORUM_DTD);
   $xml -> setDoctype ($dtd);
 
   # create root element 'Forum'
@@ -399,7 +404,8 @@ sub sort_thread ($$) {
   for (@smsg) {
     ++$z;
     splice @smsg,$z,0,@{$mhash{$_ -> {mid}}} if ($_ -> {answers});
-    delete $_ -> {kids};}
+    delete $_ -> {kids};
+  }
 
   # return
   \@smsg;
@@ -465,13 +471,13 @@ sub get_all_threads ($$;$) {
   close(FILE) or return;
 
   if (wantarray) {
-    ($dtd)          = $xml =~ /<!DOCTYPE\s+\S+\s+SYSTEM\s+"([^"]+)">/;
+    $dtd            = FORUM_DTD;
     ($last_thread)  = map {/(\d+)/} $xml =~ /<Forum.+?lastThread="([^"]+)"[^>]*>/;
     ($last_message) = map {/(\d+)/} $xml =~ /<Forum.+?lastMessage="([^"]+)"[^>]*>/;
   }
 
   my $reg_msg = qr~(?:</Message>
-                     |<Message\s+id="m(\d+)"\s+unid="([^"]*)"(?:\s+invisible="([^"]*)")?(?:\s+archive="([^"]*)")?[^>]*>\s*
+                     |<Message\s+id="m(\d+)"(?:\s+unid="([^"]*)")?(?:\s+invisible="([^"]*)")?(?:\s+archive="([^"]*)")?[^>]*>\s*
                       <Header>[^<]*(?:<(?!Name>)[^<]*)*
                         <Name>([^<]+)</Name>[^<]*(?:<(?!Category>)[^<]*)*
                         <Category>([^<]*)</Category>\s*
@@ -491,7 +497,7 @@ sub get_all_threads ($$;$) {
         push @stack,$cmno if (defined $cmno);
         push @msg, {
           mid     => $1,
-          unid    => $2,
+          unid    => (defined $2) ? $2 : '',
           deleted => $3 || 0,
           archive => $4 || 0,
           name    => $5,
@@ -507,11 +513,11 @@ sub get_all_threads ($$;$) {
         if (defined $cmno)
         {
           push @{$msg[$cmno] -> {kids}}  => $#msg;
-          push @{$msg[$cmno] -> {unids}} => $2;
+          push @{$msg[$cmno] -> {unids}} => (defined $2) ? $2 : '#';
         }
         else
         {
-          push @unids => $2;
+          push @unids => (defined $2) ? $2 : '';
         }
 
         $msg[$_] -> {answers}++ for (@stack);
@@ -527,7 +533,7 @@ sub get_all_threads ($$;$) {
       {
         push @msg, {
           mid     => $1,
-          unid    => $2,
+          unid    => (defined $2) ? $2 : '',
           deleted => $3 || 0,
           archive => $4 || 0,
           name    => $5,
@@ -543,12 +549,12 @@ sub get_all_threads ($$;$) {
         if (defined $cmno)
         {
           push @{$msg[$cmno] -> {kids}}  => $#msg;
-          push @{$msg[$cmno] -> {unids}} => $2;
+          push @{$msg[$cmno] -> {unids}} => (defined $2) ? $2 : '';
           $msg[$cmno] -> {answers}++;
         }
         else
         {
-          push @unids => $2;
+          push @unids => (defined $2) ? $2 : '';
         }
 
         $msg[$_] -> {answers}++ for (@stack);
@@ -588,9 +594,9 @@ sub create_forum_xml_string ($$) {
   my ($level, $thread, $msg);
 
   my $xml =
-      '<?xml version="1.0" encoding="UTF-8"?>'."\n"
-    . '<!DOCTYPE Forum SYSTEM "'.$param -> {dtd}.'">'."\n"
-    . '<Forum lastMessage="'.$param -> {lastMessage}.'" lastThread="'.$param -> {lastThread}.'">';
+      '<?xml version="1.0"?>'."\n"
+    . '<!DOCTYPE Forum SYSTEM "'.FORUM_DTD.'">'."\n"
+    . '<Forum lastMessage="m'.($param->{lastMessage} =~ /(\d+)/)[0].'" lastThread="t'.($param->{lastThread} =~ /(\d+)/)[0].'">';
 
   for $thread (sort {$b <=> $a} keys %$threads) {
     $xml .= '<Thread id="t'.$thread.'">';
@@ -602,7 +608,7 @@ sub create_forum_xml_string ($$) {
       $level = $msg -> {level};
       $xml  .=
           '<Message id="m'.$msg -> {mid}.'"'
-            . ' unid="'.$msg -> {unid}.'"'
+            . (($msg -> {unid})   ?' unid="'.$msg -> {unid}.'"':'')
             . (($msg -> {deleted})?' invisible="1"':'')
             . (($msg -> {archive})?' archive="1"':'')
             . '>'
@@ -683,26 +689,26 @@ sub month($) {
 }
 
 sub hr_time ($) {
-  my (undef, $min, $hour, $day, $mon, $year) = germantime (shift);
+  my (undef, $min, $hour, $day, $mon, $year) = localtime (shift);
 
   sprintf ('%02d. %s %04d, %02d:%02d Uhr', $day, month($mon+1), $year+1900, $hour, $min);
 }
 
 sub short_hr_time ($) {
-  my (undef, $min, $hour, $day, $mon, $year) = germantime (shift);
+  my (undef, $min, $hour, $day, $mon, $year) = localtime (shift);
 
   sprintf ('%02d. %02d. %04d, %02d:%02d Uhr', $day, $mon+1, $year+1900, $hour, $min);
 }
 
 sub long_hr_time ($) {
   my @wday  = qw(Sonntag Montag Dienstag Mittwoch Donnerstag Freitag Samstag);
-  my ($sek, $min, $hour, $day, $mon, $year, $wday) = germantime (shift);
+  my ($sek, $min, $hour, $day, $mon, $year, $wday) = localtime (shift);
 
   sprintf ('%s, %02d. %s %04d, %02d:%02d:%02d Uhr', $wday[$wday], $day, month($mon+1), $year+1900, $hour, $min, $sek);
 }
 
 sub very_short_hr_time($) {
-  my (undef, $min, $hour, $day, $mon, $year) = germantime (shift);
+  my (undef, $min, $hour, $day, $mon, $year) = localtime (shift);
 
   sprintf ('%02d. %02d. %04d', $day, $mon+1, $year+1900);
 }