selfforum-cgi/shared/Posting/Write.pm

   1 package Posting::Write;
   2
   3 ################################################################################
   4 #                                                                              #
   5 # File:        shared/Posting/Write.pm                                         #
   6 #                                                                              #
   7 # Authors:     André Malo <nd@o3media.de>, 2001-02-25                          #
   8 #                                                                              #
   9 # Description: Save a posting                                                  #
  10 #                                                                              #
  11 ################################################################################
  12
  13 use strict;
  14
  15 use base qw(Exporter);
  16
  17 # ====================================================
  18 # Funktionsexport
  19 # ====================================================
  20
  21 @Posting::Write::EXPORT = qw(write_posting);
  22
  23 use Encode::Plain; $Encode::Plain::utf8 = 1;
  24 use Encode::Posting;
  25 use Lock qw(:WRITE release_file);
  26 use Posting::_lib qw(get_message_node get_message_header create_forum_xml_string save_file);
  27
  28 use XML::DOM;
  29
  30 ################################
  31 # sub write_posting
  32 #
  33 # Neues Posting speichern
  34 ################################
  35
  36 sub write_posting ($) {
  37   my $param = shift;
  38   my ($thread,$tid);
  39   my $mid   = 'm'.($param -> {lastMessage} + 1);
  40
  41   my $pars = {quoteChars => $param -> {quoteChars},
  42               messages   => $param -> {messages}};
  43
  44   my %error = (threadWrite => '1 could not write thread file',
  45                forumWrite  => '2 could not write forum file',
  46                threadFile  => '3 could not load thread file',
  47                noParent    => '4 could not find parent message');
  48
  49   # neue Nachricht
  50   unless ($param -> {parentMessage}) {
  51     $tid   = 't'.($param -> {lastThread} + 1);
  52     $thread = create_new_thread ({msg      => $mid,
  53                                   ip       => $param -> {ip},
  54                                   name     => $param -> {author},
  55                                   email    => $param -> {email},
  56                                   home     => $param -> {homepage},
  57                                   image    => $param -> {image},
  58                                   category => $param -> {category},
  59                                   subject  => $param -> {subject},
  60                                   time     => $param -> {time},
  61                                   dtd      => $param -> {dtd},
  62                                   thread   => $tid,
  63                                   body     => $param -> {body},
  64                                   pars     => $pars});
  65
  66     save_file ($param -> {messagePath}.$tid.'.xml',\($thread -> toString)) or return $error{threadWrite};
  67
  68     # Thread eintragen
  69     $param -> {parsedThreads}
  70            -> {$param -> {lastThread} + 1} = [{mid     => $param -> {lastMessage} + 1,
  71                                                unid    => $param -> {uniqueID},
  72                                                name    => plain($param -> {author}),
  73                                                cat     => plain(length($param -> {category})?$param->{category}:''),
  74                                                subject => plain($param -> {subject}),
  75                                                time    => plain($param -> {time})}];
  76
  77     my $forum = create_forum_xml_string ($param -> {parsedThreads},
  78                                         {dtd         => $param -> {dtd},
  79                                          lastMessage => $mid,
  80                                          lastThread  => $tid});
  81
  82     save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};
  83     release_file ($param -> {messagePath}.$tid.'.xml');
  84     return (0, $thread, $mid);}
  85
  86   # Reply
  87   else {
  88     $tid   = 't'.($param -> {thread});
  89     my $tfile = $param -> {messagePath}.$tid.'.xml';
  90     my $xml;
  91
  92     unless (write_lock_file ($tfile)) {
  93       violent_unlock_file ($tfile);
  94       return $error{threadFile};}
  95
  96     else {
  97       $xml = eval {local $SIG{__DIE__}; new XML::DOM::Parser (KeepCDATA => 1) -> parsefile ($tfile);};
  98
  99       if ($@) {
 100         violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
 101         return $error{threadFile};}
 102
 103       my $mnode = get_message_node ($xml, $tid, 'm'.$param -> {parentMessage});
 104
 105       unless (defined $mnode) {
 106         violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
 107         return $error{noParent};}
 108
 109       my $pheader = get_message_header ($mnode);
 110
 111       my $message = create_message ($xml,
 112                                    {msg      => $mid,
 113                                     ip       => $param -> {ip},
 114                                     name     => $param -> {author},
 115                                     email    => $param -> {email},
 116                                     home     => $param -> {homepage},
 117                                     image    => $param -> {image},
 118                                     category => length($param -> {category})?$param -> {category}:$pheader -> {category},
 119                                     subject  => length($param -> {subject})?$param -> {subject}:$pheader -> {subject},
 120                                     time     => $param -> {time},
 121                                     pars     => $pars});
 122
 123       $mnode -> appendChild ($message);
 124
 125       my $mcontent = $xml -> createElement ('MessageContent');
 126          $mcontent -> setAttribute ('mid', $mid);
 127          $mcontent -> appendChild ($xml -> createCDATASection (${encoded_body(\($param -> {body}), $pars)}));
 128
 129       my $content = $xml -> getElementsByTagName ('ContentList', 1) -> item (0);
 130          $content -> appendChild ($mcontent);
 131
 132       unless (save_file ($tfile, \($xml -> toString))) {
 133         violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
 134         return $error{threadWrite};}
 135
 136       violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
 137
 138       $thread = $xml;
 139
 140       # Message eintragen
 141       # ACHTUNG! danach kann der Threadbaum nicht mehr fuer die visuelle
 142       # Ausgabe genutzt werden, da die answers nicht angepasst werden
 143       # (und somit nicht mehr stimmen...)
 144
 145       my $i=1;
 146       my $cat  = length($param -> {category})?$param -> {category}:$pheader -> {category};
 147       my $subj = length($param -> {subject})?$param -> {subject}:$pheader -> {subject};
 148
 149       for (@{$param -> {parsedThreads} -> {$param -> {thread}}}) {
 150         if ($_ -> {mid} == $param -> {parentMessage}) {
 151           splice @{$param -> {parsedThreads} -> {$param -> {thread}}},$i,0,
 152             {mid     => $param -> {lastMessage} + 1,
 153              unid    => $param -> {uniqueID},
 154              name    => plain ($param -> {author}),
 155              cat     => plain(length($cat)?$cat:''),
 156              subject => plain(length($subj)?$subj:''),
 157              level   => $_ -> {level} + 1,
 158              time    => plain ($param -> {time})};
 159           last;}
 160         $i++;}
 161
 162       my $forum = create_forum_xml_string ($param -> {parsedThreads},
 163                                           {dtd         => $param -> {dtd},
 164                                            lastMessage => $mid,
 165                                            lastThread  => 't'.$param -> {lastThread}});
 166
 167       save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};
 168     }
 169
 170     return (0, $thread, $mid);
 171   }
 172 }
 173
 174 # ====================================================
 175 # Private Funktionen
 176 # ====================================================
 177
 178 sub create_message ($$) {
 179   my ($xml,$par) = @_;
 180
 181   my $message = $xml -> createElement ('Message');
 182   $message -> setAttribute ('id', $par -> {msg});
 183   $message -> setAttribute ('ip', $par -> {ip});
 184
 185   # Header erzeugen
 186   my $header = $xml -> createElement ('Header');
 187
 188   # alles inside of 'Header'
 189   my $author   = $xml -> createElement ('Author');
 190     my $name  = $xml -> createElement ('Name');
 191     $name -> addText ($par -> {name});
 192     $author -> appendChild ($name);
 193
 194     my $email = $xml -> createElement ('Email');
 195     $email -> addText ($par -> {email});
 196     $author -> appendChild ($email);
 197
 198     if (length ($par -> {home})) {
 199       my $home  = $xml -> createElement ('HomepageUrl');
 200       $home -> addText ($par -> {home});
 201       $author -> appendChild ($home);}
 202
 203     if (length ($par -> {image})) {
 204       my $image = $xml -> createElement ('ImageUrl');
 205       $image -> addText ($par -> {image});
 206       $author -> appendChild ($image);}
 207
 208   my $category = $xml -> createElement ('Category');
 209   $category -> addText ($par -> {category});
 210
 211   my $subject  = $xml -> createElement ('Subject');
 212   $subject -> addText ($par -> {subject});
 213
 214   my $date     = $xml -> createElement ('Date');
 215   $date -> setAttribute ('longSec', $par -> {time});
 216
 217     $header -> appendChild ($author);
 218     $header -> appendChild ($category);
 219     $header -> appendChild ($subject);
 220     $header -> appendChild ($date);
 221     $message -> appendChild ($header);
 222
 223   $message;
 224 }
 225
 226 sub create_new_thread ($) {
 227   my $par = shift;
 228
 229   # neues Dokument
 230   my $xml = new XML::DOM::Document;
 231
 232   # XML-declaration
 233   my $decl = new XML::DOM::XMLDecl;
 234   $decl -> setVersion  ('1.0');
 235   $decl -> setEncoding ('UTF-8');
 236   $xml -> setXMLDecl ($decl);
 237
 238   # Doctype
 239   my $dtd = $xml -> createDocumentType ('Forum', $par -> {dtd}, undef, undef);
 240   $xml -> setDoctype ($dtd);
 241
 242   # Root erzeugen
 243   my $forum = $xml -> createElement ('Forum');
 244
 245   # Thread erzeugen
 246   my $thread = $xml -> createElement ('Thread');
 247   $thread -> setAttribute ('id', $par -> {thread});
 248
 249   # Message erzeugen
 250   my $message = create_message ($xml,$par);
 251
 252   # Contentlist
 253   my $content  = $xml -> createElement ('ContentList');
 254   my $mcontent = $xml -> createElement ('MessageContent');
 255   $mcontent -> setAttribute ('mid', $par -> {msg});
 256   $mcontent -> appendChild ($xml -> createCDATASection (${encoded_body(\($par -> {body}), $par -> {pars} )}));
 257
 258   # die ganzen Nodes verknuepfen
 259       $thread -> appendChild ($message);
 260     $forum -> appendChild ($thread);
 261
 262       $content -> appendChild ($mcontent);
 263     $forum -> appendChild ($content);
 264
 265   $xml -> appendChild ($forum);
 266
 267   # und fertiges Dokument zurueckgeben
 268   $xml;
 269 }
 270
 271 # ====================================================
 272 # Modulinitialisierung
 273 # ====================================================
 274
 275 # making require happy
 276 1;
 277
 278 # ====================================================
 279 # end of Posting::Write
 280 # ====================================================