X-Git-Url: https://git.p6c8.net/selfforum.git/blobdiff_plain/915cf9b760b3f56439001746a7af73ab0ebcf986..8bd9a0d82f7e21d9340a4470258e2cad2638deca:/selfforum-cgi/shared/Posting/Write.pm diff --git a/selfforum-cgi/shared/Posting/Write.pm b/selfforum-cgi/shared/Posting/Write.pm index 0a76a02..b7338f6 100644 --- a/selfforum-cgi/shared/Posting/Write.pm +++ b/selfforum-cgi/shared/Posting/Write.pm @@ -4,305 +4,254 @@ package Posting::Write; # # # File: shared/Posting/Write.pm # # # -# Authors: André Malo , 2001-02-25 # +# Authors: André Malo , 2001-04-08 # # # # Description: Save a posting # # # ################################################################################ use strict; - -use base qw(Exporter); - -# ==================================================== -# Funktionsexport -# ==================================================== - -@Posting::Write::EXPORT = qw(write_posting); +use vars qw( + %error + @EXPORT + $VERSION +); use Encode::Plain; $Encode::Plain::utf8 = 1; use Encode::Posting; -use Lock qw(:WRITE release_file); -use Posting::_lib qw(get_message_node get_message_header create_forum_xml_string save_file); +use Lock qw( + :WRITE + release_file +); +use Posting::_lib qw( + get_message_node + get_message_header + create_forum_xml_string + create_new_thread + create_message + save_file + parse_xml_file + KEEP_DELETED +); use XML::DOM; -################################ -# sub write_posting +%error = ( + threadWrite => '1 could not write thread file', + forumWrite => '2 could not write forum file', + threadFile => '3 could not load thread file', + noParent => '4 could not find parent message' +); + +################################################################################ +# +# Version check +# +$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; + +################################################################################ +# +# Export # -# Neues Posting speichern -################################ +use base qw(Exporter); +@EXPORT = qw( + write_new_thread + write_reply_posting +); -sub write_posting ($) { +### sub write_new_thread ($) ################################################### +# +# save a posting and update the forum main file +# +# Params: $param - hashreference +# (see doc for details) +# +# Return: (0 or error, thread-xml, new mid) +# +sub write_new_thread ($) { my $param = shift; - my ($thread,$tid); + my $thread; my $mid = 'm'.($param -> {lastMessage} + 1); + my $tid = 't'.($param -> {lastThread} + 1); + # define the params needed for a new thread + # my $pars = { - quoteChars => $param -> {quoteChars}, - messages => $param -> {messages} + msg => $mid, + ip => $param -> {ip}, + name => defined $param -> {author} ? $param -> {author} : '', + email => defined $param -> {email} ? $param -> {email} : '', + home => defined $param -> {homepage} ? $param -> {homepage} : '', + image => defined $param -> {image} ? $param -> {image} : '', + category => defined $param -> {category} ? $param -> {category} : '', + subject => defined $param -> {subject} ? $param -> {subject} : '', + body => encoded_body( + \($param -> {body}), + { quoteChars => $param -> {quoteChars}, + messages => $param -> {messages}, + base_uri => $param -> {base_uri} + } + ), + time => $param -> {time}, + dtd => $param -> {dtd}, + thread => $tid }; - my %error = ( - threadWrite => '1 could not write thread file', - forumWrite => '2 could not write forum file', - threadFile => '3 could not load thread file', - noParent => '4 could not find parent message' - ); + # create new thread and save it to disk + # + $thread = create_new_thread ($pars); + save_file ($param -> {messagePath}.$tid.'.xml',\($thread -> toString)) or return $error{threadWrite}; + + # update forum main file + # + $param + -> {parsedThreads} + -> {$param -> {lastThread} + 1} = [ + { mid => $param -> {lastMessage} + 1, + unid => $param -> {uniqueID}, + name => plain($pars -> {name}), + cat => plain($pars -> {category}), + subject => plain($pars -> {subject}), + time => plain($pars -> {time}), + level => 0, + } + ]; - # neue Nachricht - unless ($param -> {parentMessage}) { - $tid = 't'.($param -> {lastThread} + 1); - $thread = create_new_thread ( - { msg => $mid, - ip => $param -> {ip}, - name => $param -> {author}, - email => $param -> {email}, - home => $param -> {homepage}, - image => $param -> {image}, - category => $param -> {category}, - subject => $param -> {subject}, - time => $param -> {time}, - dtd => $param -> {dtd}, - thread => $tid, - body => $param -> {body}, - pars => $pars - } - ); + my $forum = create_forum_xml_string ( + $param -> {parsedThreads}, + { dtd => $pars -> {dtd}, + lastMessage => $mid, + lastThread => $tid + } + ); - save_file ($param -> {messagePath}.$tid.'.xml',\($thread -> toString)) or return $error{threadWrite}; + save_file ($param -> {forumFile}, $forum) or return $error{forumWrite}; + release_file ($param -> {messagePath}.$tid.'.xml'); + return (0, $thread, $mid, $tid); +} - # Thread eintragen - $param - -> {parsedThreads} - -> {$param -> {lastThread} + 1} = [ - { mid => $param -> {lastMessage} + 1, - unid => $param -> {uniqueID}, - name => plain($param -> {author}), - cat => plain(length($param -> {category})?$param->{category}:''), - subject => plain($param -> {subject}), - time => plain($param -> {time}) - } - ]; +### sub write_reply_posting ($) ################################################ +# +# save a reply and update the forum main file +# +# Params: $param - hashreference +# (see doc for details) +# +# Return: (0 or error, thread-xml, new mid) +# +sub write_reply_posting ($) { + my $param = shift; + my $thread; + my $mid = 'm'.($param -> {lastMessage} + 1); + my $tid = 't'.($param -> {thread}); - my $forum = create_forum_xml_string ( - $param -> {parsedThreads}, - { dtd => $param -> {dtd}, - lastMessage => $mid, - lastThread => $tid - } - ); + my $tfile = $param -> {messagePath}.$tid.'.xml'; - save_file ($param -> {forumFile}, $forum) or return $error{forumWrite}; - release_file ($param -> {messagePath}.$tid.'.xml'); - return (0, $thread, $mid);} + unless (write_lock_file ($tfile)) { + violent_unlock_file ($tfile); + return $error{threadFile}; + } - # Reply else { - $tid = 't'.($param -> {thread}); - my $tfile = $param -> {messagePath}.$tid.'.xml'; - my $xml; + my $xml = parse_xml_file ($tfile); - unless (write_lock_file ($tfile)) { - violent_unlock_file ($tfile); + unless ($xml) { + violent_unlock_file ($tfile) unless (write_unlock_file ($tfile)); return $error{threadFile}; } - else { - $xml = eval { - local $SIG{__DIE__}; - new XML::DOM::Parser (KeepCDATA => 1) -> parsefile ($tfile); - }; - - if ($@) { - violent_unlock_file ($tfile) unless (write_unlock_file ($tfile)); - return $error{threadFile}; - } - - my $mnode = get_message_node ($xml, $tid, 'm'.$param -> {parentMessage}); - - unless (defined $mnode) { - violent_unlock_file ($tfile) unless (write_unlock_file ($tfile)); - return $error{noParent}; - } - - my $pheader = get_message_header ($mnode); - - my $message = create_message ( - $xml, - { msg => $mid, - ip => $param -> {ip}, - name => $param -> {author}, - email => $param -> {email}, - home => $param -> {homepage}, - image => $param -> {image}, - category => length($param -> {category})?$param -> {category}:$pheader -> {category}, - subject => length($param -> {subject})?$param -> {subject}:$pheader -> {subject}, - time => $param -> {time}, - pars => $pars - } - ); - - $mnode -> appendChild ($message); - - my $mcontent = $xml -> createElement ('MessageContent'); - $mcontent -> setAttribute ('mid', $mid); - $mcontent -> appendChild ($xml -> createCDATASection (${encoded_body(\($param -> {body}), $pars)})); - - my $content = $xml -> getElementsByTagName ('ContentList', 1) -> item (0); - $content -> appendChild ($mcontent); - - unless (save_file ($tfile, \($xml -> toString))) { - violent_unlock_file ($tfile) unless (write_unlock_file ($tfile)); - return $error{threadWrite}; - } + my $mnode = get_message_node ($xml, $tid, 'm'.$param -> {parentMessage}); + unless (defined $mnode) { violent_unlock_file ($tfile) unless (write_unlock_file ($tfile)); - - $thread = $xml; - - # Message eintragen - # ACHTUNG! danach kann der Threadbaum nicht mehr fuer die visuelle - # Ausgabe genutzt werden, da die answers nicht angepasst werden - # (und somit nicht mehr stimmen...) - - my $i=1; - my $cat = length($param -> {category})?$param -> {category}:$pheader -> {category}; - my $subj = length($param -> {subject})?$param -> {subject}:$pheader -> {subject}; - - for (@{$param -> {parsedThreads} -> {$param -> {thread}}}) { - if ($_ -> {mid} == $param -> {parentMessage}) { - splice @{$param -> {parsedThreads} -> {$param -> {thread}}}, $i, 0, - { mid => $param -> {lastMessage} + 1, - unid => $param -> {uniqueID}, - name => plain ($param -> {author}), - cat => plain(length($cat)?$cat:''), - subject => plain(length($subj)?$subj:''), - level => $_ -> {level} + 1, - time => plain ($param -> {time}) - }; - last;} - $i++;} - - my $forum = create_forum_xml_string ( - $param -> {parsedThreads}, - { dtd => $param -> {dtd}, - lastMessage => $mid, - lastThread => 't'.$param -> {lastThread} - } - ); - - save_file ($param -> {forumFile}, $forum) or return $error{forumWrite}; + return $error{noParent}; } - return (0, $thread, $mid); - } -} - -# ==================================================== -# Private Funktionen -# ==================================================== - -sub create_message ($$) { - my ($xml,$par) = @_; - - my $message = $xml -> createElement ('Message'); - $message -> setAttribute ('id', $par -> {msg}); - $message -> setAttribute ('ip', $par -> {ip}); - - # Header erzeugen - my $header = $xml -> createElement ('Header'); - - # alles inside of 'Header' - my $author = $xml -> createElement ('Author'); - my $name = $xml -> createElement ('Name'); - $name -> addText ($par -> {name}); - $author -> appendChild ($name); - - my $email = $xml -> createElement ('Email'); - $email -> addText ($par -> {email}); - $author -> appendChild ($email); - - if (length ($par -> {home})) { - my $home = $xml -> createElement ('HomepageUrl'); - $home -> addText ($par -> {home}); - $author -> appendChild ($home);} - - if (length ($par -> {image})) { - my $image = $xml -> createElement ('ImageUrl'); - $image -> addText ($par -> {image}); - $author -> appendChild ($image);} - - my $category = $xml -> createElement ('Category'); - $category -> addText ($par -> {category}); - - my $subject = $xml -> createElement ('Subject'); - $subject -> addText ($par -> {subject}); - - my $date = $xml -> createElement ('Date'); - $date -> setAttribute ('longSec', $par -> {time}); - - $header -> appendChild ($author); - $header -> appendChild ($category); - $header -> appendChild ($subject); - $header -> appendChild ($date); - $message -> appendChild ($header); - - $message; -} - -sub create_new_thread ($) { - my $par = shift; - - # neues Dokument - my $xml = new XML::DOM::Document; - - # XML-declaration - my $decl = new XML::DOM::XMLDecl; - $decl -> setVersion ('1.0'); - $decl -> setEncoding ('UTF-8'); - $xml -> setXMLDecl ($decl); - - # Doctype - my $dtd = $xml -> createDocumentType ('Forum', $par -> {dtd}, undef, undef); - $xml -> setDoctype ($dtd); + my $pars = { + msg => $mid, + ip => $param -> {ip}, + name => defined $param -> {author} ? $param -> {author} :'', + email => defined $param -> {email} ? $param -> {email} :'', + home => defined $param -> {homepage} ? $param -> {homepage} :'', + image => defined $param -> {image} ? $param -> {image} :'', + category => defined $param -> {category} ? $param -> {category} :'', + subject => defined $param -> {subject} ? $param -> {subject} :'', + time => $param -> {time}, + }; + + my $message = create_message ($xml, $pars); + + $mnode -> appendChild ($message); + + my $mcontent = $xml -> createElement ('MessageContent'); + $mcontent -> setAttribute ('mid' => $mid); + $mcontent -> appendChild ( + $xml -> createCDATASection ( + ${encoded_body( + \($param -> {body}), + { quoteChars => $param -> {quoteChars}, + messages => $param -> {messages}, + base_uri => $param -> {base_uri} + } + )} + ) + ); - # Root erzeugen - my $forum = $xml -> createElement ('Forum'); + my $content = $xml -> getElementsByTagName ('ContentList', 1) -> item (0); + $content -> appendChild ($mcontent); - # Thread erzeugen - my $thread = $xml -> createElement ('Thread'); - $thread -> setAttribute ('id', $par -> {thread}); + # save thread file + # + unless (save_file ($tfile, \($xml -> toString))) { + violent_unlock_file ($tfile) unless (write_unlock_file ($tfile)); + return $error{threadWrite}; + } - # Message erzeugen - my $message = create_message ($xml,$par); + violent_unlock_file ($tfile) unless (write_unlock_file ($tfile)); - # Contentlist - my $content = $xml -> createElement ('ContentList'); - my $mcontent = $xml -> createElement ('MessageContent'); - $mcontent -> setAttribute ('mid', $par -> {msg}); - $mcontent -> appendChild ($xml -> createCDATASection (${encoded_body(\($par -> {body}), $par -> {pars} )})); + $thread = $xml; - # die ganzen Nodes verknuepfen - $thread -> appendChild ($message); - $forum -> appendChild ($thread); + # add message to thread tree + # ATTENTION: don't use the tree for visual output after this operation + # + my $i=1; + for (@{$param -> {parsedThreads} -> {$param -> {thread}}}) { + if ($_ -> {mid} == $param -> {parentMessage}) { + splice @{ + $param -> {parsedThreads} -> {$param -> {thread}}},$i, 0, + { mid => $param -> {lastMessage} + 1, + unid => plain ($param -> {uniqueID}), + name => plain ($pars -> {name}), + cat => plain ($pars -> {category}), + subject => plain ($pars -> {subject}), + level => $_ -> {level} + 1, + time => plain ($pars -> {time}) + }; + last; + } + $i++; + } - $content -> appendChild ($mcontent); - $forum -> appendChild ($content); + # create & save forum main file + # + my $forum = create_forum_xml_string ( + $param -> {parsedThreads}, + { dtd => $param -> {dtd}, + lastMessage => $mid, + lastThread => 't'.$param -> {lastThread} + } + ); - $xml -> appendChild ($forum); + save_file ($param -> {forumFile}, $forum) or return $error{forumWrite}; + } - # und fertiges Dokument zurueckgeben - $xml; + return (0, $thread, $mid, $tid); } -# ==================================================== -# Modulinitialisierung -# ==================================================== - -# making require happy +# keep 'require' happy +# 1; -# ==================================================== -# end of Posting::Write -# ==================================================== \ No newline at end of file +# +# +### end of Posting::Write ###################################################### \ No newline at end of file