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