# #
# File: shared/Posting/Write.pm #
# #
-# Authors: André Malo <nd@o3media.de>, 2001-02-25 #
+# Authors: André Malo <nd@o3media.de>, 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;
+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'
+);
+
+################################################################################
#
-# Neues Posting speichern
-################################
+# Version check
+#
+$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 $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};
+ new Lock ($param -> {messagePath}.$tid.'.xml') -> release;
+ 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 = new Lock ($param -> {messagePath}.$tid.'.xml');
- save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};
- release_file ($param -> {messagePath}.$tid.'.xml');
- return (0, $thread, $mid);}
+ unless ($tfile->lock(LH_EXCL)) {
+ return $error{threadFile};
+ }
- # Reply
else {
- $tid = 't'.($param -> {thread});
- my $tfile = $param -> {messagePath}.$tid.'.xml';
- my $xml;
+ my $xml = parse_xml_file ($tfile->filename);
- unless (write_lock_file ($tfile)) {
- violent_unlock_file ($tfile);
+ unless ($xml) {
+ $tfile -> unlock;
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});
- my $mnode = get_message_node ($xml, $tid, 'm'.$param -> {parentMessage});
+ unless (defined $mnode) {
+ $tfile -> unlock;
+ return $error{noParent};
+ }
- unless (defined $mnode) {
- violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
- 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 $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
- }
- );
+ my $content = $xml -> getElementsByTagName ('ContentList', 1) -> item (0);
+ $content -> appendChild ($mcontent);
- $mnode -> appendChild ($message);
+ # save thread file
+ #
+ unless (save_file ($tfile->filename, \($xml -> toString))) {
+ $tfile -> unlock;
+ return $error{threadWrite};
+ }
- my $mcontent = $xml -> createElement ('MessageContent');
- $mcontent -> setAttribute ('mid', $mid);
- $mcontent -> appendChild ($xml -> createCDATASection (${encoded_body(\($param -> {body}), $pars)}));
+ $tfile -> unlock;
- my $content = $xml -> getElementsByTagName ('ContentList', 1) -> item (0);
- $content -> appendChild ($mcontent);
+ $thread = $xml;
- unless (save_file ($tfile, \($xml -> toString))) {
- violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
- return $error{threadWrite};
+ # 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;
}
-
- 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};
+ $i++;
}
- 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);
-
- # 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);
-
- # 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} )}));
-
- # die ganzen Nodes verknuepfen
- $thread -> appendChild ($message);
- $forum -> appendChild ($thread);
-
- $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
git.p6c8.net / selfforum.git / blobdiff