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-01-29
   6 # ====================================================
   7 # Funktion:
   8 #      Speicherung eines Postings
   9 # ====================================================
  10
  11 use strict;
  12
  13 package Posting::Write;
  14
  15 use vars qw(@ISA @EXPORT);
  16
  17 # ====================================================
  18 # Funktionsexport
  19 # ====================================================
  20
  21 require Exporter;
  22 @ISA    = qw(Exporter);
  23 @EXPORT = qw(write_posting);
  24
  25 use Encode::Plain; $Encode::Plain::utf8 = 1;
  26 use Encode::Posting;
  27 use Lock qw(:WRITE release_file);
  28 use Posting::_lib qw(get_message_node get_message_header create_forum_xml_string save_file);
  29
  30 use XML::DOM;
  31
  32 ################################
  33 # sub write_posting
  34 #
  35 # Neues Posting speichern
  36 ################################
  37
  38 sub write_posting ($) {
  39   my $param = shift;
  40   my ($thread,$tid);
  41   my $mid   = 'm'.($param -> {lastMessage} + 1);
  42
  43   my $pars = {quoteChars => $param -> {quoteChars},
  44               messages   => $param -> {messages}};
  45
  46   my %error = (threadWrite => '1 could not write thread file',
  47                forumWrite  => '2 could not write forum file',
  48                threadFile  => '3 could not load thread file',
  49                noParent    => '4 could not find parent message');
  50
  51   # neue Nachricht
  52   unless ($param -> {parentMessage}) {
  53     $tid   = 't'.($param -> {lastThread} + 1);
  54     $thread = create_new_thread ({msg      => $mid,
  55                                   ip       => $param -> {ip},
  56                                   name     => $param -> {author},
  57                                   email    => $param -> {email},
  58                                   home     => $param -> {homepage},
  59                                   image    => $param -> {image},
  60                                   category => $param -> {category},
  61                                   subject  => $param -> {subject},
  62                                   time     => $param -> {time},
  63                                   dtd      => $param -> {dtd},
  64                                   thread   => $tid,
  65                                   body     => $param -> {body},
  66                                   pars     => $pars});
  67
  68     save_file ($param -> {messagePath}.$tid.'.xml',\($thread -> toString)) or return $error{threadWrite};
  69
  70     # Thread eintragen
  71     $param -> {parsedThreads}
  72            -> {$param -> {lastThread} + 1} = [{mid     => $param -> {lastMessage} + 1,
  73                                                unid    => $param -> {uniqueID},
  74                                                name    => plain($param -> {author}),
  75                                                cat     => plain(length($param -> {category})?$param->{category}:''),
  76                                                subject => plain($param -> {subject}),
  77                                                time    => plain($param -> {time})}];
  78
  79     my $forum = create_forum_xml_string ($param -> {parsedThreads},
  80                                         {dtd         => $param -> {dtd},
  81                                          lastMessage => $mid,
  82                                          lastThread  => $tid});
  83
  84     save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};
  85     release_file ($param -> {messagePath}.$tid.'.xml');
  86     return (0, $thread, $mid);}
  87
  88   # Reply
  89   else {
  90     $tid   = 't'.($param -> {thread});
  91     my $tfile = $param -> {messagePath}.$tid.'.xml';
  92     my $xml;
  93
  94     unless (write_lock_file ($tfile)) {
  95       violent_unlock_file ($tfile);
  96       return $error{threadFile};}
  97
  98     else {
  99       $xml = eval {local $SIG{__DIE__}; new XML::DOM::Parser (KeepCDATA => 1) -> parsefile ($tfile);};
 100
 101       if ($@) {
 102         violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
 103         return $error{threadFile};}
 104
 105       my $mnode = get_message_node ($xml, $tid, 'm'.$param -> {parentMessage});
 106
 107       unless (defined $mnode) {
 108         violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
 109         return $error{noParent};}
 110
 111       my $pheader = get_message_header ($mnode);
 112
 113       my $message = create_message ($xml,
 114                                    {msg      => $mid,
 115                                     ip       => $param -> {ip},
 116                                     name     => $param -> {author},
 117                                     email    => $param -> {email},
 118                                     home     => $param -> {homepage},
 119                                     image    => $param -> {image},
 120                                     category => length($param -> {category})?$param -> {category}:$pheader -> {category},
 121                                     subject  => length($param -> {subject})?$param -> {subject}:$pheader -> {subject},
 122                                     time     => $param -> {time},
 123                                     pars     => $pars});
 124
 125       $mnode -> appendChild ($message);
 126
 127       my $mcontent = $xml -> createElement ('MessageContent');
 128          $mcontent -> setAttribute ('mid', $mid);
 129          $mcontent -> appendChild ($xml -> createCDATASection (${encoded_body(\($param -> {body}), $pars)}));
 130
 131       my $content = $xml -> getElementsByTagName ('ContentList', 1) -> item (0);
 132          $content -> appendChild ($mcontent);
 133
 134       unless (save_file ($tfile, \($xml -> toString))) {
 135         violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
 136         return $error{threadWrite};}
 137
 138       violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
 139
 140       $thread = $xml;
 141
 142       # Message eintragen
 143       # ACHTUNG! danach kann der Threadbaum nicht mehr fuer die visuelle
 144       # Ausgabe genutzt werden, da die answers nicht angepasst werden
 145       # (und somit nicht mehr stimmen...)
 146
 147       my $i=1;
 148       my $cat  = length($param -> {category})?$param -> {category}:$pheader -> {category};
 149       my $subj = length($param -> {subject})?$param -> {subject}:$pheader -> {subject};
 150
 151       for (@{$param -> {parsedThreads} -> {$param -> {thread}}}) {
 152         if ($_ -> {mid} == $param -> {parentMessage}) {
 153           splice @{$param -> {parsedThreads} -> {$param -> {thread}}},$i,0,
 154             {mid     => $param -> {lastMessage} + 1,
 155              unid    => $param -> {uniqueID},
 156              name    => plain ($param -> {author}),
 157              cat     => plain(length($cat)?$cat:''),
 158              subject => plain(length($subj)?$subj:''),
 159              level   => $_ -> {level} + 1,
 160              time    => plain ($param -> {time})};
 161           last;}
 162         $i++;}
 163
 164       my $forum = create_forum_xml_string ($param -> {parsedThreads},
 165                                           {dtd         => $param -> {dtd},
 166                                            lastMessage => $mid,
 167                                            lastThread  => 't'.$param -> {lastThread}});
 168
 169       save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};}
 170
 171   return (0, $thread, $mid);}
 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 # ====================================================