integrated new version of Lock.pm

[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 7e6ba975b9d9fe31162be01290f9ffde2157383b..5670251bdb48ca8f047c929ba1892102d3dd9031 100644 (file)
--- a/selfforum-cgi/shared/Posting/Write.pm
+++ b/selfforum-cgi/shared/Posting/Write.pm
@@ -4,278 +4,250 @@ 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 vars qw(@EXPORT);
-use base qw(Exporter);
-
-# ====================================================
-# Funktionsexport
-# ====================================================
-
-@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;
+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 $pars = {quoteChars => $param -> {quoteChars},
-              messages   => $param -> {messages}};
-
-  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');
-
-  # 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});
-
-    save_file ($param -> {messagePath}.$tid.'.xml',\($thread -> toString)) or return $error{threadWrite};
-
-    # Thread eintragen
-    $param -> {parsedThreads}
-           -> {$param -> {lastThread} + 1} = [{mid     => $param -> {lastMessage} + 1,
-                                               unid    => $param -> {uniqueID},
-                                               name    => plain($param -> {author}),
-                                               cat     => plain(length($param -> {category})?$param->{category}:''),
-                                               subject => plain($param -> {subject}),
-                                               time    => plain($param -> {time})}];
-
-    my $forum = create_forum_xml_string ($param -> {parsedThreads},
-                                        {dtd         => $param -> {dtd},
-                                         lastMessage => $mid,
-                                         lastThread  => $tid});
-
-    save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};
-    release_file ($param -> {messagePath}.$tid.'.xml');
-    return (0, $thread, $mid);}
-
-  # Reply
-  else {
-    $tid   = 't'.($param -> {thread});
-    my $tfile = $param -> {messagePath}.$tid.'.xml';
-    my $xml;
-
-    unless (write_lock_file ($tfile)) {
-      violent_unlock_file ($tfile);
-      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};}
-
-      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};
+  my $tid   = 't'.($param -> {lastThread} + 1);
+
+  # define the params needed for a new thread
+  #
+  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}  : '',
+    body     => encoded_body(
+      \($param -> {body}),
+      { quoteChars => $param -> {quoteChars},
+        messages   => $param -> {messages},
+        base_uri   => $param -> {base_uri}
+      }
+    ),
+    time     => $param -> {time},
+    dtd      => $param -> {dtd},
+    thread   => $tid
+  };
+
+  # 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,
+        }
+       ];
+
+  my $forum = create_forum_xml_string (
+    $param -> {parsedThreads},
+    { dtd         => $pars -> {dtd},
+      lastMessage => $mid,
+      lastThread  => $tid

     }
     }

+  );

 
 

-    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;
+  save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};
+  new Lock ($param -> {messagePath}.$tid.'.xml') -> release;
+  return (0, $thread, $mid, $tid);

 }
 
 }
 

-sub create_new_thread ($) {
-  my $par = shift;
+### 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});

 
 

-  # neues Dokument
-  my $xml = new XML::DOM::Document;
+  my $tfile = new Lock ($param -> {messagePath}.$tid.'.xml');

 
 

-  # XML-declaration
-  my $decl = new XML::DOM::XMLDecl;
-  $decl -> setVersion  ('1.0');
-  $decl -> setEncoding ('UTF-8');
-  $xml -> setXMLDecl ($decl);
+  unless ($tfile->lock(LH_EXCL)) {
+    return $error{threadFile};
+  }

 
 

-  # Doctype
-  my $dtd = $xml -> createDocumentType ('Forum', $par -> {dtd}, undef, undef);
-  $xml -> setDoctype ($dtd);
+  else {
+    my $xml = parse_xml_file ($tfile->filename);

 
 

-  # Root erzeugen
-  my $forum = $xml -> createElement ('Forum');
+    unless ($xml) {
+      $tfile -> unlock;
+      return $error{threadFile};
+    }

 
 

-  # Thread erzeugen
-  my $thread = $xml -> createElement ('Thread');
-  $thread -> setAttribute ('id', $par -> {thread});
+    my $mnode = get_message_node ($xml, $tid, 'm'.$param -> {parentMessage});

 
 

-  # Message erzeugen
-  my $message = create_message ($xml,$par);
+    unless (defined $mnode) {
+      $tfile -> unlock;
+      return $error{noParent};
+    }

 
 

-  # 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} )}));
+    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}
+          }
+        )}
+      )
+    );
+
+    my $content = $xml -> getElementsByTagName ('ContentList', 1) -> item (0);
+       $content -> appendChild ($mcontent);
+
+    # save thread file
+    #
+    unless (save_file ($tfile->filename, \($xml -> toString))) {
+      $tfile -> unlock;
+      return $error{threadWrite};
+    }

 
 

-  # die ganzen Nodes verknuepfen
-      $thread -> appendChild ($message);
-    $forum -> appendChild ($thread);
+    $tfile -> unlock;
+
+    $thread = $xml;
+
+    # 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
-# ====================================================
+#
+#
+### end of Posting::Write ######################################################
\ No newline at end of file