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 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
 171     return (0, $thread, $mid);
 172   }
 173 }
 174
 175 # ====================================================
 176 # Private Funktionen
 177 # ====================================================
 178
 179 sub create_message ($$) {
 180   my ($xml,$par) = @_;
 181
 182   my $message = $xml -> createElement ('Message');
 183   $message -> setAttribute ('id', $par -> {msg});
 184   $message -> setAttribute ('ip', $par -> {ip});
 185
 186   # Header erzeugen
 187   my $header = $xml -> createElement ('Header');
 188
 189   # alles inside of 'Header'
 190   my $author   = $xml -> createElement ('Author');
 191     my $name  = $xml -> createElement ('Name');
 192     $name -> addText ($par -> {name});
 193     $author -> appendChild ($name);
 194
 195     my $email = $xml -> createElement ('Email');
 196     $email -> addText ($par -> {email});
 197     $author -> appendChild ($email);
 198
 199     if (length ($par -> {home})) {
 200       my $home  = $xml -> createElement ('HomepageUrl');
 201       $home -> addText ($par -> {home});
 202       $author -> appendChild ($home);}
 203
 204     if (length ($par -> {image})) {
 205       my $image = $xml -> createElement ('ImageUrl');
 206       $image -> addText ($par -> {image});
 207       $author -> appendChild ($image);}
 208
 209   my $category = $xml -> createElement ('Category');
 210   $category -> addText ($par -> {category});
 211
 212   my $subject  = $xml -> createElement ('Subject');
 213   $subject -> addText ($par -> {subject});
 214
 215   my $date     = $xml -> createElement ('Date');
 216   $date -> setAttribute ('longSec', $par -> {time});
 217
 218     $header -> appendChild ($author);
 219     $header -> appendChild ($category);
 220     $header -> appendChild ($subject);
 221     $header -> appendChild ($date);
 222     $message -> appendChild ($header);
 223
 224   $message;
 225 }
 226
 227 sub create_new_thread ($) {
 228   my $par = shift;
 229
 230   # neues Dokument
 231   my $xml = new XML::DOM::Document;
 232
 233   # XML-declaration
 234   my $decl = new XML::DOM::XMLDecl;
 235   $decl -> setVersion  ('1.0');
 236   $decl -> setEncoding ('UTF-8');
 237   $xml -> setXMLDecl ($decl);
 238
 239   # Doctype
 240   my $dtd = $xml -> createDocumentType ('Forum', $par -> {dtd}, undef, undef);
 241   $xml -> setDoctype ($dtd);
 242
 243   # Root erzeugen
 244   my $forum = $xml -> createElement ('Forum');
 245
 246   # Thread erzeugen
 247   my $thread = $xml -> createElement ('Thread');
 248   $thread -> setAttribute ('id', $par -> {thread});
 249
 250   # Message erzeugen
 251   my $message = create_message ($xml,$par);
 252
 253   # Contentlist
 254   my $content  = $xml -> createElement ('ContentList');
 255   my $mcontent = $xml -> createElement ('MessageContent');
 256   $mcontent -> setAttribute ('mid', $par -> {msg});
 257   $mcontent -> appendChild ($xml -> createCDATASection (${encoded_body(\($par -> {body}), $par -> {pars} )}));
 258
 259   # die ganzen Nodes verknuepfen
 260       $thread -> appendChild ($message);
 261     $forum -> appendChild ($thread);
 262
 263       $content -> appendChild ($mcontent);
 264     $forum -> appendChild ($content);
 265
 266   $xml -> appendChild ($forum);
 267
 268   # und fertiges Dokument zurueckgeben
 269   $xml;
 270 }
 271
 272 # ====================================================
 273 # Modulinitialisierung
 274 # ====================================================
 275
 276 # making require happy
 277 1;
 278
 279 # ====================================================
 280 # end of Posting::Write
 281 # ====================================================