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