X-Git-Url: https://git.p6c8.net/selfforum.git/blobdiff_plain/f247cc770243a474bbba7845094047e0995b9746..df7bba65634dbc997ba06409e25a49b8be9dd139:/selfforum-cgi/shared/Posting/Write.pm?ds=sidebyside diff --git a/selfforum-cgi/shared/Posting/Write.pm b/selfforum-cgi/shared/Posting/Write.pm index 72a5b25..5670251 100644 --- a/selfforum-cgi/shared/Posting/Write.pm +++ b/selfforum-cgi/shared/Posting/Write.pm @@ -1,279 +1,253 @@ -# Posting/Write.pm - -# ==================================================== -# Autor: n.d.p. / 2001-01-29 -# lm : n.d.p. / 2001-02-25 -# ==================================================== -# Funktion: -# Speicherung eines Postings -# ==================================================== - -use strict; - package Posting::Write; -use vars qw(@EXPORT); -use base qw(Exporter); - -# ==================================================== -# Funktionsexport -# ==================================================== +################################################################################ +# # +# File: shared/Posting/Write.pm # +# # +# Authors: André Malo , 2001-04-08 # +# # +# Description: Save a posting # +# # +################################################################################ -@EXPORT = qw(write_posting); +use strict; +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; +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 # -# Neues Posting speichern -################################ +$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; -sub write_posting ($) { +################################################################################ +# +# Export +# +use base qw(Exporter); +@EXPORT = qw( + write_new_thread + write_reply_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 $pars = {quoteChars => $param -> {quoteChars}, - messages => $param -> {messages}}; - - 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'); - - # 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}); - - save_file ($param -> {messagePath}.$tid.'.xml',\($thread -> toString)) or return $error{threadWrite}; - - # 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})}]; - - my $forum = create_forum_xml_string ($param -> {parsedThreads}, - {dtd => $param -> {dtd}, - lastMessage => $mid, - lastThread => $tid}); - - save_file ($param -> {forumFile}, $forum) or return $error{forumWrite}; - release_file ($param -> {messagePath}.$tid.'.xml'); - return (0, $thread, $mid);} - - # Reply - else { - $tid = 't'.($param -> {thread}); - my $tfile = $param -> {messagePath}.$tid.'.xml'; - my $xml; - - unless (write_lock_file ($tfile)) { - violent_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};} - - 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 (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; + my $tid = 't'.($param -> {lastThread} + 1); + + # define the params needed for a new thread + # + 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} : '', + body => encoded_body( + \($param -> {body}), + { quoteChars => $param -> {quoteChars}, + messages => $param -> {messages}, + base_uri => $param -> {base_uri} + } + ), + time => $param -> {time}, + dtd => $param -> {dtd}, + thread => $tid + }; + + # 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, + } + ]; + + my $forum = create_forum_xml_string ( + $param -> {parsedThreads}, + { dtd => $pars -> {dtd}, + lastMessage => $mid, + lastThread => $tid + } + ); + + save_file ($param -> {forumFile}, $forum) or return $error{forumWrite}; + new Lock ($param -> {messagePath}.$tid.'.xml') -> release; + return (0, $thread, $mid, $tid); } -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); - - # Root erzeugen - my $forum = $xml -> createElement ('Forum'); - - # Thread erzeugen - my $thread = $xml -> createElement ('Thread'); - $thread -> setAttribute ('id', $par -> {thread}); - - # Message erzeugen - my $message = create_message ($xml,$par); +### 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}); - # 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} )})); + my $tfile = new Lock ($param -> {messagePath}.$tid.'.xml'); - # die ganzen Nodes verknuepfen - $thread -> appendChild ($message); - $forum -> appendChild ($thread); + unless ($tfile->lock(LH_EXCL)) { + return $error{threadFile}; + } - $content -> appendChild ($mcontent); - $forum -> appendChild ($content); + else { + my $xml = parse_xml_file ($tfile->filename); + + unless ($xml) { + $tfile -> unlock; + return $error{threadFile}; + } + + my $mnode = get_message_node ($xml, $tid, 'm'.$param -> {parentMessage}); + + unless (defined $mnode) { + $tfile -> unlock; + return $error{noParent}; + } + + 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} + } + )} + ) + ); + + my $content = $xml -> getElementsByTagName ('ContentList', 1) -> item (0); + $content -> appendChild ($mcontent); + + # save thread file + # + unless (save_file ($tfile->filename, \($xml -> toString))) { + $tfile -> unlock; + return $error{threadWrite}; + } + + $tfile -> unlock; + + $thread = $xml; + + # 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++; + } + + # 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