added version checks and some comments, removed Posting::_lib::create_message_xml...

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

diff --git a/selfforum-cgi/shared/Posting/Write.pm b/selfforum-cgi/shared/Posting/Write.pm
index eed1534639be7e774367cc49cb4218998ba64995..b7338f657a940b61ea0942612054a7d1c346361e 100644 (file)
--- a/selfforum-cgi/shared/Posting/Write.pm
+++ b/selfforum-cgi/shared/Posting/Write.pm
@@ -4,306 +4,254 @@ package Posting::Write;
 #                                                                              #
 # File:        shared/Posting/Write.pm                                         #
 #                                                                              #
 #                                                                              #
 # File:        shared/Posting/Write.pm                                         #
 #                                                                              #

-# Authors:     André Malo <nd@o3media.de>, 2001-02-25                          #
+# Authors:     André Malo <nd@o3media.de>, 2001-04-08                          #

 #                                                                              #
 # Description: Save a posting                                                  #
 #                                                                              #
 ################################################################################
 
 use strict;
 #                                                                              #
 # Description: Save a posting                                                  #
 #                                                                              #
 ################################################################################
 
 use strict;

-
-use base qw(Exporter);
-
-# ====================================================
-# Funktionsexport
-# ====================================================
-
-@Posting::Write::EXPORT = qw(write_posting);
+use vars qw(
+  %error
+  @EXPORT
+  $VERSION
+);

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

-use Lock qw(:WRITE release_file);
-use Posting::_lib qw(get_message_node get_message_header create_forum_xml_string save_file);
+use Lock qw(
+  :WRITE
+  release_file
+);
+use Posting::_lib qw(
+  get_message_node
+  get_message_header
+  create_forum_xml_string
+  create_new_thread
+  create_message
+  save_file
+  parse_xml_file
+  KEEP_DELETED
+);

 
 use XML::DOM;
 
 
 use XML::DOM;
 

-################################
-# sub write_posting
+%error = (
+  threadWrite => '1 could not write thread file',
+  forumWrite  => '2 could not write forum file',
+  threadFile  => '3 could not load thread file',
+  noParent    => '4 could not find parent message'
+);
+
+################################################################################
+#
+# Version check
+#
+$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+
+################################################################################
+#
+# Export

 #
 #

-# Neues Posting speichern
-################################
+use base qw(Exporter);
+@EXPORT = qw(
+  write_new_thread
+  write_reply_posting
+);

 
 

-sub write_posting ($) {
+### sub write_new_thread ($) ###################################################
+#
+# save a posting and update the forum main file
+#
+# Params: $param - hashreference
+#                  (see doc for details)
+#
+# Return: (0 or error, thread-xml, new mid)
+#
+sub write_new_thread ($) {

   my $param = shift;
   my $param = shift;

-  my ($thread,$tid);
+  my $thread;

   my $mid   = 'm'.($param -> {lastMessage} + 1);
   my $mid   = 'm'.($param -> {lastMessage} + 1);

+  my $tid   = 't'.($param -> {lastThread} + 1);

 
 

+  # define the params needed for a new thread
+  #

   my $pars = {
   my $pars = {

-    quoteChars => $param -> {quoteChars},
-    messages   => $param -> {messages}
+    msg      => $mid,
+    ip       => $param -> {ip},
+    name     => defined $param -> {author}   ? $param -> {author}   : '',
+    email    => defined $param -> {email}    ? $param -> {email}    : '',
+    home     => defined $param -> {homepage} ? $param -> {homepage} : '',
+    image    => defined $param -> {image}    ? $param -> {image}    : '',
+    category => defined $param -> {category} ? $param -> {category} : '',
+    subject  => defined $param -> {subject}  ? $param -> {subject}  : '',
+    body     => encoded_body(
+      \($param -> {body}),
+      { quoteChars => $param -> {quoteChars},
+        messages   => $param -> {messages},
+        base_uri   => $param -> {base_uri}
+      }
+    ),
+    time     => $param -> {time},
+    dtd      => $param -> {dtd},
+    thread   => $tid

   };
 
   };
 

-  my %error = (
-    threadWrite => '1 could not write thread file',
-    forumWrite  => '2 could not write forum file',
-    threadFile  => '3 could not load thread file',
-    noParent    => '4 could not find parent message'
-  );
+  # create new thread and save it to disk
+  #
+  $thread = create_new_thread ($pars);
+  save_file ($param -> {messagePath}.$tid.'.xml',\($thread -> toString)) or return $error{threadWrite};
+
+  # update forum main file
+  #
+  $param
+    -> {parsedThreads}
+    -> {$param -> {lastThread} + 1} = [
+        { mid     => $param -> {lastMessage} + 1,
+          unid    => $param -> {uniqueID},
+          name    => plain($pars -> {name}),
+          cat     => plain($pars -> {category}),
+          subject => plain($pars -> {subject}),
+          time    => plain($pars -> {time}),
+          level   => 0,
+        }
+       ];

 
 

-  # neue Nachricht
-  unless ($param -> {parentMessage}) {
-    $tid   = 't'.($param -> {lastThread} + 1);
-    $thread = create_new_thread (
-      { msg      => $mid,
-        ip       => $param -> {ip},
-        name     => $param -> {author}   || '',
-        email    => $param -> {email}    || '',
-        home     => $param -> {homepage} || '',
-        image    => $param -> {image}    || '',
-        category => $param -> {category} || '',
-        subject  => $param -> {subject}  || '',
-        time     => $param -> {time},
-        dtd      => $param -> {dtd},
-        thread   => $tid,
-        body     => $param -> {body}     || '',
-        pars     => $pars
-      }
-    );
+  my $forum = create_forum_xml_string (
+    $param -> {parsedThreads},
+    { dtd         => $pars -> {dtd},
+      lastMessage => $mid,
+      lastThread  => $tid
+    }
+  );

 
 

-    save_file ($param -> {messagePath}.$tid.'.xml',\($thread -> toString)) or return $error{threadWrite};
+  save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};
+  release_file ($param -> {messagePath}.$tid.'.xml');
+  return (0, $thread, $mid, $tid);
+}

 
 

-    # Thread eintragen
-    $param
-      -> {parsedThreads}
-      -> {$param -> {lastThread} + 1} = [
-          { mid     => $param -> {lastMessage} + 1,
-            unid    => $param -> {uniqueID},
-            name    => plain($param -> {author}),
-            cat     => plain(defined $param -> {category}?$param->{category}:''),
-            subject => plain($param -> {subject}),
-            time    => plain($param -> {time}),
-            level   => 0,
-          }
-         ];
+### sub write_reply_posting ($) ################################################
+#
+# save a reply and update the forum main file
+#
+# Params: $param - hashreference
+#                  (see doc for details)
+#
+# Return: (0 or error, thread-xml, new mid)
+#
+sub write_reply_posting ($) {
+  my $param = shift;
+  my $thread;
+  my $mid   = 'm'.($param -> {lastMessage} + 1);
+  my $tid   = 't'.($param -> {thread});

 
 

-    my $forum = create_forum_xml_string (
-         $param -> {parsedThreads},
-         { dtd         => $param -> {dtd},
-           lastMessage => $mid,
-           lastThread  => $tid
-         }
-       );
+  my $tfile = $param -> {messagePath}.$tid.'.xml';

 
 

-    save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};
-    release_file ($param -> {messagePath}.$tid.'.xml');
-    return (0, $thread, $mid);}
+  unless (write_lock_file ($tfile)) {
+    violent_unlock_file ($tfile);
+    return $error{threadFile};
+  }

 
 

-  # Reply

   else {
   else {

-    $tid   = 't'.($param -> {thread});
-    my $tfile = $param -> {messagePath}.$tid.'.xml';
-    my $xml;
+    my $xml = parse_xml_file ($tfile);

 
 

-    unless (write_lock_file ($tfile)) {
-      violent_unlock_file ($tfile);
+    unless ($xml) {
+      violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));

       return $error{threadFile};
     }
 
       return $error{threadFile};
     }
 

-    else {
-      $xml = eval {
-        local $SIG{__DIE__};
-        new XML::DOM::Parser (KeepCDATA => 1) -> parsefile ($tfile);
-      };
-
-      if ($@) {
-        violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
-        return $error{threadFile};
-      }
-
-      my $mnode = get_message_node ($xml, $tid, 'm'.$param -> {parentMessage});
-
-      unless (defined $mnode) {
-        violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
-        return $error{noParent};
-      }
-
-      my $pheader = get_message_header ($mnode);
-
-      my $message = create_message (
-        $xml,
-        { msg      => $mid,
-          ip       => $param -> {ip},
-          name     => $param -> {author},
-          email    => $param -> {email},
-          home     => $param -> {homepage},
-          image    => $param -> {image},
-          category => length($param -> {category})?$param -> {category}:$pheader -> {category},
-          subject  => length($param -> {subject})?$param -> {subject}:$pheader -> {subject},
-          time     => $param -> {time},
-          pars     => $pars
-        }
-      );
-
-      $mnode -> appendChild ($message);
-
-      my $mcontent = $xml -> createElement ('MessageContent');
-         $mcontent -> setAttribute ('mid', $mid);
-         $mcontent -> appendChild ($xml -> createCDATASection (${encoded_body(\($param -> {body}), $pars)}));
-
-      my $content = $xml -> getElementsByTagName ('ContentList', 1) -> item (0);
-         $content -> appendChild ($mcontent);
-
-      unless (save_file ($tfile, \($xml -> toString))) {
-        violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
-        return $error{threadWrite};
-      }
+    my $mnode = get_message_node ($xml, $tid, 'm'.$param -> {parentMessage});

 
 

+    unless (defined $mnode) {

       violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
       violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));

-
-      $thread = $xml;
-
-      # Message eintragen
-      # ACHTUNG! danach kann der Threadbaum nicht mehr fuer die visuelle
-      # Ausgabe genutzt werden, da die answers nicht angepasst werden
-      # (und somit nicht mehr stimmen...)
-
-      my $i=1;
-      my $cat  = length($param -> {category})?$param -> {category}:$pheader -> {category};
-      my $subj = length($param -> {subject})?$param -> {subject}:$pheader -> {subject};
-
-      for (@{$param -> {parsedThreads} -> {$param -> {thread}}}) {
-        if ($_ -> {mid} == $param -> {parentMessage}) {
-          splice @{$param -> {parsedThreads} -> {$param -> {thread}}}, $i, 0,
-            { mid     => $param -> {lastMessage} + 1,
-              unid    => $param -> {uniqueID},
-              name    => plain ($param -> {author}),
-              cat     => plain(length($cat)?$cat:''),
-              subject => plain(length($subj)?$subj:''),
-              level   => $_ -> {level} + 1,
-              time    => plain ($param -> {time})
-            };
-          last;}
-        $i++;}
-
-      my $forum = create_forum_xml_string (
-        $param -> {parsedThreads},
-        { dtd         => $param -> {dtd},
-          lastMessage => $mid,
-          lastThread  => 't'.$param -> {lastThread}
-        }
-      );
-
-      save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};
+      return $error{noParent};

     }
 
     }
 

-    return (0, $thread, $mid);
-  }
-}
-
-# ====================================================
-# Private Funktionen
-# ====================================================
-
-sub create_message ($$) {
-  my ($xml,$par) = @_;
-
-  my $message = $xml -> createElement ('Message');
-  $message -> setAttribute ('id', $par -> {msg});
-  $message -> setAttribute ('ip', $par -> {ip});
-
-  # Header erzeugen
-  my $header = $xml -> createElement ('Header');
-
-  # alles inside of 'Header'
-  my $author   = $xml -> createElement ('Author');
-    my $name  = $xml -> createElement ('Name');
-    $name -> addText ($par -> {name});
-    $author -> appendChild ($name);
-
-    my $email = $xml -> createElement ('Email');
-    $email -> addText ($par -> {email});
-    $author -> appendChild ($email);
-
-    if (length ($par -> {home})) {
-      my $home  = $xml -> createElement ('HomepageUrl');
-      $home -> addText ($par -> {home});
-      $author -> appendChild ($home);}
-
-    if (length ($par -> {image})) {
-      my $image = $xml -> createElement ('ImageUrl');
-      $image -> addText ($par -> {image});
-      $author -> appendChild ($image);}
-
-  my $category = $xml -> createElement ('Category');
-  $category -> addText ($par -> {category});
-
-  my $subject  = $xml -> createElement ('Subject');
-  $subject -> addText ($par -> {subject});
-
-  my $date     = $xml -> createElement ('Date');
-  $date -> setAttribute ('longSec', $par -> {time});
-
-    $header -> appendChild ($author);
-    $header -> appendChild ($category);
-    $header -> appendChild ($subject);
-    $header -> appendChild ($date);
-    $message -> appendChild ($header);
-
-  $message;
-}
-
-sub create_new_thread ($) {
-  my $par = shift;
-
-  # neues Dokument
-  my $xml = new XML::DOM::Document;
-
-  # XML-declaration
-  my $decl = new XML::DOM::XMLDecl;
-  $decl -> setVersion  ('1.0');
-  $decl -> setEncoding ('UTF-8');
-  $xml -> setXMLDecl ($decl);
-
-  # Doctype
-  my $dtd = $xml -> createDocumentType ('Forum', $par -> {dtd}, undef, undef);
-  $xml -> setDoctype ($dtd);
+    my $pars = {
+      msg      => $mid,
+      ip       => $param -> {ip},
+      name     => defined $param -> {author}   ? $param -> {author}   :'',
+      email    => defined $param -> {email}    ? $param -> {email}    :'',
+      home     => defined $param -> {homepage} ? $param -> {homepage} :'',
+      image    => defined $param -> {image}    ? $param -> {image}    :'',
+      category => defined $param -> {category} ? $param -> {category} :'',
+      subject  => defined $param -> {subject}  ? $param -> {subject}  :'',
+      time     => $param -> {time},
+    };
+
+    my $message = create_message ($xml, $pars);
+
+    $mnode -> appendChild ($message);
+
+    my $mcontent = $xml -> createElement ('MessageContent');
+    $mcontent -> setAttribute ('mid' => $mid);
+    $mcontent -> appendChild (
+      $xml -> createCDATASection (
+        ${encoded_body(
+          \($param -> {body}),
+          { quoteChars => $param -> {quoteChars},
+            messages   => $param -> {messages},
+            base_uri   => $param -> {base_uri}
+          }
+        )}
+      )
+    );

 
 

-  # Root erzeugen
-  my $forum = $xml -> createElement ('Forum');
+    my $content = $xml -> getElementsByTagName ('ContentList', 1) -> item (0);
+       $content -> appendChild ($mcontent);

 
 

-  # Thread erzeugen
-  my $thread = $xml -> createElement ('Thread');
-  $thread -> setAttribute ('id', $par -> {thread});
+    # save thread file
+    #
+    unless (save_file ($tfile, \($xml -> toString))) {
+      violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
+      return $error{threadWrite};
+    }

 
 

-  # Message erzeugen
-  my $message = create_message ($xml,$par);
+    violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));

 
 

-  # Contentlist
-  my $content  = $xml -> createElement ('ContentList');
-  my $mcontent = $xml -> createElement ('MessageContent');
-  $mcontent -> setAttribute ('mid', $par -> {msg});
-  $mcontent -> appendChild ($xml -> createCDATASection (${encoded_body(\($par -> {body}), $par -> {pars} )}));
+    $thread = $xml;

 
 

-  # die ganzen Nodes verknuepfen
-      $thread -> appendChild ($message);
-    $forum -> appendChild ($thread);
+    # add message to thread tree
+    # ATTENTION: don't use the tree for visual output after this operation
+    #
+    my $i=1;
+    for (@{$param -> {parsedThreads} -> {$param -> {thread}}}) {
+      if ($_ -> {mid} == $param -> {parentMessage}) {
+        splice @{
+          $param -> {parsedThreads} -> {$param -> {thread}}},$i, 0,
+          { mid     => $param -> {lastMessage} + 1,
+            unid    => plain ($param -> {uniqueID}),
+            name    => plain ($pars -> {name}),
+            cat     => plain ($pars -> {category}),
+            subject => plain ($pars -> {subject}),
+            level   => $_ -> {level} + 1,
+            time    => plain ($pars -> {time})
+          };
+        last;
+      }
+      $i++;
+    }

 
 

-      $content -> appendChild ($mcontent);
-    $forum -> appendChild ($content);
+    # create & save forum main file
+    #
+    my $forum = create_forum_xml_string (
+      $param -> {parsedThreads},
+      { dtd         => $param -> {dtd},
+        lastMessage => $mid,
+        lastThread  => 't'.$param -> {lastThread}
+      }
+    );

 
 

-  $xml -> appendChild ($forum);
+    save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};
+  }

 
 

-  # und fertiges Dokument zurueckgeben
-  $xml;
+  return (0, $thread, $mid, $tid);

 }
 
 }
 

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

 1;
 
 1;
 

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