selfforum-cgi/shared/Posting/Write.pm

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