shared/Posting/Write.pm: comments added and some things modified to work with new 'fo_posting.pl'
shared/Posting/_lib.pm: inserted 'create_new_thread' and 'create_message' from Posting::Write
user/fo_posting.pl: should now run stable
user/config/*.xml: adjusted to work with new 'fo_posting.pl'
# and wait $timeout seconds for
# references == 0 (no shared locks set)
#
- &simple_lock ($filename,$timeout) or return;
+ &simple_lock ($filename,$timeout) or return 0;
for (0..$timeout) {
# lock reference counter
# or fail
#
unless (&simple_lock (&reffile($filename),$timeout)) {
&simple_unlock($filename,$timeout);
- return;
+ return 0;
}
# ready if we have no shared locks
#
unless (&simple_unlock (&reffile($filename),$timeout)) {
&simple_unlock($filename,$timeout);
- return;
+ return 0;
}
sleep(1);
}
# and wait $timeout seconds for
# references == 0 (no shared locks set)
#
- &simple_lock ($filename,$timeout) or return;
+ &simple_lock ($filename,$timeout) or return 0;
for (0..$timeout) {
# lock reference counter
#
unless (&simple_lock (&reffile($filename),$timeout)) {
&simple_unlock($filename,$timeout);
- return;
+ return 0;
}
# ready if we have no shared locks
#
unless (&simple_unlock (&reffile($filename),$timeout)) {
&simple_unlock($filename,$timeout);
- return;
+ return 0;
}
sleep(1);
}
# #
# 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);
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'
+);
+
+################################################################################
#
-# Neues Posting speichern
-################################
+# Export
+#
+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}
+ }
+ ),
+ 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);
+}
- # Thread eintragen
- $param
- -> {parsedThreads}
- -> {$param -> {lastThread} + 1} = [
- { mid => $param -> {lastMessage} + 1,
- unid => $param -> {uniqueID},
- name => plain($param -> {author}),
- cat => plain(defined $param -> {category}?$param->{category}:''),
- subject => plain($param -> {subject}),
- time => plain($param -> {time}),
- level => 0,
- }
- ];
+### 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}
+ }
+ )}
+ )
+ );
- # 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 => $tid
+ }
+ );
- $xml -> appendChild ($forum);
+ save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};
+ }
- # und fertiges Dokument zurueckgeben
- $xml;
+ return (0, $thread, $mid);
}
-# ====================================================
-# Modulinitialisierung
-# ====================================================
-
-# making require happy
+# keeping 'require' happy
+#
1;
-# ====================================================
-# end of Posting::Write
-# ====================================================
\ No newline at end of file
+#
+#
+### end of Posting::Write ######################################################
\ No newline at end of file
use base qw(Exporter);
@Posting::_lib::EXPORT_OK = qw(
- get_message_header get_message_body get_message_node get_body_node parse_single_thread parse_xml_file
- hr_time short_hr_time long_hr_time
- get_all_threads create_forum_xml_string
+ get_message_header
+ get_message_body
+ get_message_node
+ get_body_node
+ parse_single_thread
+ parse_xml_file
+ create_new_thread
+ create_message
+
+ hr_time
+ short_hr_time
+ long_hr_time
+
+ get_all_threads
+ create_forum_xml_string
+
save_file
- SORT_ASCENT SORT_DESCENT KEEP_DELETED KILL_DELETED
+
+ SORT_ASCENT
+ SORT_DESCENT
+ KEEP_DELETED
+ KILL_DELETED
);
# ====================================================
# Access via XML::DOM
# ====================================================
+### sub create_message ($$) ####################################################
+#
+# create the 'Message' subtree
+#
+# Params: $xml - XML::DOM::Document object
+# $par - hash reference
+# (msg, ip, name, email, home, image, category, subject, time)
+#
+# Return: XML::DOM::Element object
+#
+sub create_message ($$) {
+ my ($xml,$par) = @_;
+
+ my $message = $xml -> createElement ('Message');
+ $message -> setAttribute ('id' => $par -> {msg});
+ $message -> setAttribute ('ip' => $par -> {ip});
+
+ my $header = $xml -> createElement ('Header');
+ my $author = $xml -> createElement ('Author');
+
+ my @may = (
+ ['name' => 'Name' => $author],
+ ['email' => 'Email' => $author],
+ ['home' => 'HomepageUrl' => $author],
+ ['image' => 'ImageUrl' => $author],
+ ['category' => 'Category' => $header],
+ ['subject' => 'Subject' => $header]
+ );# key => element name => superior
+
+ for (@may) {
+
+ # create element
+ my $obj = $xml -> createElement ($_->[1]);
+
+ # insert content
+ $obj -> addText (
+ defined $par -> {$_->[0]}
+ ? $par -> {$_->[0]}
+ : ''
+ );
+
+ # link to superior element
+ $_ -> [2] -> appendChild ($obj);
+ }
+
+ my $date = $xml -> createElement ('Date');
+ $date -> setAttribute ('longSec'=> $par -> {time});
+
+ $header -> appendChild ($author);
+ $header -> appendChild ($date);
+ $message -> appendChild ($header);
+
+ # return
+ #
+ $message;
+}
+
+### sub create_new_thread ($) ##################################################
+#
+# create a XML::DOM::Document object of a thread containing one posting
+#
+# Params: hash reference
+# (dtd, thread, msg, body, ip, name, email, home,
+# image, category, subject, time)
+#
+# Return: XML::DOM::Document object
+#
+sub create_new_thread ($) {
+ my $par = shift;
+
+ # new document
+ #
+ 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);
+
+ # set doctype
+ #
+ my $dtd = $xml -> createDocumentType ('Forum' => $par -> {dtd});
+ $xml -> setDoctype ($dtd);
+
+ # create root element 'Forum'
+ # create element 'Thread'
+ # create 'Message' subtree
+ # create element 'ContentList'
+ # create 'MessageContent' subtree
+ #
+ my $forum = $xml -> createElement ('Forum');
+ my $thread = $xml -> createElement ('Thread');
+ $thread -> setAttribute ('id' => $par -> {thread});
+ my $message = create_message ($xml,$par);
+ my $content = $xml -> createElement ('ContentList');
+ my $mcontent = $xml -> createElement ('MessageContent');
+ $mcontent -> setAttribute ('mid' => $par -> {msg});
+ $mcontent -> appendChild (
+ $xml -> createCDATASection (${$par -> {body}})
+ );
+
+ # link all the nodes to
+ # their superior elements
+ #
+ $thread -> appendChild ($message);
+ $forum -> appendChild ($thread);
+ $content -> appendChild ($mcontent);
+ $forum -> appendChild ($content);
+ $xml -> appendChild ($forum);
+
+ # return
+ #
+ $xml;
+}
+
### get_message_header () ######################################################
#
# Read message header, return as a hash
#
-# Params: $node XML message node
-# Return: Hash reference (name, category, subject, email, home, image, time)
+# Params: $node - XML message node
+# Return: hash reference (name, category, subject, email, home, image, time)
#
sub get_message_header ($)
{
my $node = shift;
my %conf;
- my $header = $node -> getElementsByTagName ('Header', 0) -> item (0);
- my $author = $header -> getElementsByTagName ('Author', 0) -> item (0);
- my $name = $author -> getElementsByTagName ('Name', 0) -> item (0);
- my $email = $author -> getElementsByTagName ('Email', 0) -> item (0);
+ my $header = $node -> getElementsByTagName ('Header' , 0) -> item (0);
+ my $author = $header -> getElementsByTagName ('Author' , 0) -> item (0);
+ my $name = $author -> getElementsByTagName ('Name' , 0) -> item (0);
+ my $email = $author -> getElementsByTagName ('Email' , 0) -> item (0);
my $home = $author -> getElementsByTagName ('HomepageUrl', 0) -> item (0);
- my $image = $author -> getElementsByTagName ('ImageUrl', 0) -> item (0);
- my $cat = $header -> getElementsByTagName ('Category', 0) -> item (0);
- my $subject = $header -> getElementsByTagName ('Subject', 0) -> item (0);
- my $date = $header -> getElementsByTagName ('Date', 0) -> item (0);
+ my $image = $author -> getElementsByTagName ('ImageUrl' , 0) -> item (0);
+ my $cat = $header -> getElementsByTagName ('Category' , 0) -> item (0);
+ my $subject = $header -> getElementsByTagName ('Subject' , 0) -> item (0);
+ my $date = $header -> getElementsByTagName ('Date' , 0) -> item (0);
%conf = (
name => ($name -> hasChildNodes)?$name -> getFirstChild -> getData:undef,
#
# Params: $xml XML::DOM::Document Object (Document Node)
# $mid Message ID
+#
# Return: MessageContent XML node (or -none-)
#
sub get_body_node ($$)
{
my ($xml, $mid) = @_;
- for ($xml->getElementsByTagName ('ContentList', 1)->item (0)->getElementsByTagName ('MessageContent', 0))
- {
+ for ($xml -> getElementsByTagName ('ContentList', 1) -> item (0) -> getElementsByTagName ('MessageContent', 0)) {
return $_ if ($_ -> getAttribute ('mid') eq $mid);
}
#
# Params: $xml XML::DOM::Document Object (Document Node)
# $mid Message ID
+#
# Return: Scalar reference
#
sub get_message_body ($$)
# Params: $xml XML::DOM::Document Object (Document Node)
# $tid Thread ID
# $mid Message ID
+#
# Return: Message XML node, Thread XML node (or -none-)
#
sub get_message_node ($$$)
my ($xml, $tid, $mid) = @_;
my ($mnode, $tnode);
- for ($xml->getElementsByTagName ('Thread'))
- {
- if ($_->getAttribute ('id') eq $tid)
- {
+ for ($xml->getElementsByTagName ('Thread')) {
+ if ($_->getAttribute ('id') eq $tid) {
$tnode = $_;
- for ($tnode -> getElementsByTagName ('Message'))
- {
- if ($_ -> getAttribute ('id') eq $mid)
- {
+
+ for ($tnode -> getElementsByTagName ('Message')) {
+ if ($_ -> getAttribute ('id') eq $mid) {
$mnode = $_;
last;
}
}
}
- wantarray ? ($mnode, $tnode) : $mnode;
+ wantarray
+ ? ($mnode, $tnode)
+ : $mnode;
}
### sub parse_xml_file ($) #####################################################
# this sub is only to avoid errors and to centralize the parse process
#
# Params: $file filename
+#
# Return: XML::DOM::Document Object (Document Node) or false
#
sub parse_xml_file ($) {
my $file = shift;
+
my $xml = eval {
- local $SIG{__DIE__}; # CGI::Carp works unreliable ;-(
- new XML::DOM::Parser (KeepCDATA => 1) -> parsefile ($file);
- };
+ local $SIG{__DIE__}; # CGI::Carp works unreliable ;-(
+ new XML::DOM::Parser (KeepCDATA => 1) -> parsefile ($file);
+ };
return if ($@);
<!--
***** Fehlermeldungen *****
- (fatal)
-->
-<Scrap id="_MANIPULATED"><![CDATA[ Die Übergabedaten sind fehlerhaft oder wurden manipuliert. Zumindest sind sie unbrauchbar, deshalb sehen Sie diese Fehlermeldung. ]]></Scrap>
-<Scrap id="_OCCUPIED"><![CDATA[ Es wird gerade ein anderes Posting bearbeitet. Bitte einfach nochmal abschicken (vorher evtl. ein paar Minuten warten). ]]></Scrap>
-<Scrap id="_UNKNOWN"><![CDATA[ Es ist ein nicht identifizierbarer Fehler aufgetreten. Wir bitten um Entschuldigung und Ihr Verständnis. Wir werden den Fehler so bald wie möglich beheben. ]]></Scrap>
-<Scrap id="_ENCODING"><![CDATA[ Die Übergabedaten konnten nicht ausgewertet werden, da eine unbekannte Zeichencodierung verwendet wurde. Dieses System unterstützt derzeit nur den Latin-1-Zeichensatz (ISO-8859-1) und (experimentell) UTF-8. ]]></Scrap>
-<Scrap id="_NAME_TOO_LONG"><![CDATA[ Überprüfen Sie bitte den Namen! Er ist zu lang{&& %IF _NUM &&} (maximal {&& _NUM &&} Zeichen){&& %ENDIF &&}. ]]></Scrap>
+<Scrap id="_MANIPULATED"><![CDATA[ Die Übergabedaten sind fehlerhaft oder wurden manipuliert. Zumindest sind sie unbrauchbar, deshalb sehen Sie diese Fehlermeldung. ]]></Scrap>
+<Scrap id="_OCCUPIED"><![CDATA[ Es wird gerade ein anderes Posting bearbeitet. Bitte einfach nochmal abschicken (vorher evtl. ein paar Minuten warten). ]]></Scrap>
+<Scrap id="_UNKNOWN"><![CDATA[ Es ist ein nicht identifizierbarer Fehler aufgetreten. Wir bitten um Entschuldigung und Ihr Verständnis. Wir werden den Fehler so bald wie möglich beheben. ]]></Scrap>
+<Scrap id="_ENCODING"><![CDATA[ Die Übergabedaten konnten nicht ausgewertet werden, da eine unbekannte Zeichencodierung verwendet wurde. Dieses System unterstützt derzeit nur den Latin-1-Zeichensatz (ISO-8859-1) und (experimentell) UTF-8. ]]></Scrap>
+<Scrap id="_NAME_TOO_LONG"><![CDATA[ Überprüfen Sie bitte den Namen! Er ist zu lang{&& %IF _NUM &&} (maximal {&& _NUM &&} Zeichen){&& %ENDIF &&}. ]]></Scrap>
<Scrap id="_NAME_TOO_SHORT"><![CDATA[ Überprüfen Sie bitte den Namen! Er ist zu kurz{&& %IF _NUM &&} (mindestens {&& _NUM &&} Zeichen){&& %ENDIF &&}. ]]></Scrap>
-<Scrap id="_MAIL_TOO_LONG"><![CDATA[ Überprüfen Sie bitte die Mailadresse! Sie ist zu lang{&& %IF _NUM &&} (maximal {&& _NUM &&} Zeichen){&& %ENDIF &&}. ]]></Scrap>
+<Scrap id="_MAIL_TOO_LONG"><![CDATA[ Überprüfen Sie bitte die Mailadresse! Sie ist zu lang{&& %IF _NUM &&} (maximal {&& _NUM &&} Zeichen){&& %ENDIF &&}. ]]></Scrap>
<Scrap id="_MAIL_TOO_SHORT"><![CDATA[ Überprüfen Sie bitte die Mailadresse! Sie ist zu kurz{&& %IF _NUM &&} (mindestens {&& _NUM &&} Zeichen){&& %ENDIF &&}. ]]></Scrap>
-<Scrap id="_MAIL_WRONG"><![CDATA[ Überprüfen Sie bitte die Mailadresse! Sie scheint nicht korrekt zu sein. ]]></Scrap>
-<Scrap id="_CAT_WRONG"><![CDATA[ Wählen Sie bitte einen Themenbereich aus dem Auswahlfeld! ]]></Scrap>
-<Scrap id="_SUB_TOO_LONG"><![CDATA[ Überprüfen Sie bitte das Thema! Es ist zu lang{&& %IF _NUM &&} (maximal {&& _NUM &&} Zeichen){&& %ENDIF &&}. ]]></Scrap>
-<Scrap id="_SUB_TOO_SHORT"><![CDATA[ Überprüfen Sie bitte das Thema! Es ist zu kurz{&& %IF _NUM &&} (mindestens {&& _NUM &&} Zeichen){&& %ENDIF &&}. ]]></Scrap>
-<Scrap id="_BODY_TOO_LONG"><![CDATA[ Überprüfen Sie bitte Ihre Mitteilung! Sie ist zu lang{&& %IF _NUM &&} (maximal {&& _NUM &&} Zeichen){&& %ENDIF &&}. ]]></Scrap>
+<Scrap id="_MAIL_WRONG"><![CDATA[ Überprüfen Sie bitte die Mailadresse! Sie scheint nicht korrekt zu sein. ]]></Scrap>
+<Scrap id="_CAT_WRONG"><![CDATA[ Wählen Sie bitte einen Themenbereich aus dem Auswahlfeld! ]]></Scrap>
+<Scrap id="_SUB_TOO_LONG"><![CDATA[ Überprüfen Sie bitte das Thema! Es ist zu lang{&& %IF _NUM &&} (maximal {&& _NUM &&} Zeichen){&& %ENDIF &&}. ]]></Scrap>
+<Scrap id="_SUB_TOO_SHORT"><![CDATA[ Überprüfen Sie bitte das Thema! Es ist zu kurz{&& %IF _NUM &&} (mindestens {&& _NUM &&} Zeichen){&& %ENDIF &&}. ]]></Scrap>
+<Scrap id="_BODY_TOO_LONG"><![CDATA[ Überprüfen Sie bitte Ihre Mitteilung! Sie ist zu lang{&& %IF _NUM &&} (maximal {&& _NUM &&} Zeichen){&& %ENDIF &&}. ]]></Scrap>
<Scrap id="_BODY_TOO_SHORT"><![CDATA[ Überprüfen Sie bitte Ihre Mitteilung! Haben Sie so wenig zu sagen? ]]></Scrap>
-<Scrap id="_URL_TOO_LONG"><![CDATA[ Überprüfen Sie bitte den Homepage-URL! Er ist zu lang{&& %IF _NUM &&} (maximal {&& _NUM &&} Zeichen){&& %ENDIF &&}. ]]></Scrap>
-<Scrap id="_IMG_TOO_LONG"><![CDATA[ Überprüfen Sie bitte den Bild-URL! Er ist zu lang{&& %IF _NUM &&} (maximal {&& _NUM &&} Zeichen){&& %ENDIF &&}. ]]></Scrap>
-<Scrap id="_NOREPLY"><![CDATA[ Die Nachricht, auf die Sie antworten möchten, wurde nicht gefunden. ]]></Scrap>
-<Scrap id="_DUPE"><![CDATA[ Sie haben (vermutlich versehentlich) versucht, das Posting mehr als einmal abzusetzen. Ihr Beitrag wurde bereits aufgenommen. ]]></Scrap>
+<Scrap id="_URL_TOO_LONG"><![CDATA[ Überprüfen Sie bitte den Homepage-URL! Er ist zu lang{&& %IF _NUM &&} (maximal {&& _NUM &&} Zeichen){&& %ENDIF &&}. ]]></Scrap>
+<Scrap id="_IMG_TOO_LONG"><![CDATA[ Überprüfen Sie bitte den Bild-URL! Er ist zu lang{&& %IF _NUM &&} (maximal {&& _NUM &&} Zeichen){&& %ENDIF &&}. ]]></Scrap>
+<Scrap id="_NOREPLY"><![CDATA[ Die Nachricht, auf die Sie antworten möchten, wurde nicht gefunden. ]]></Scrap>
+<Scrap id="_DUPE"><![CDATA[ Sie haben (vermutlich versehentlich) versucht, das Posting mehr als einmal abzusetzen. Ihr Beitrag wurde bereits aufgenommen. ]]></Scrap>
+<Scrap id="_NOT_SAVED"><![CDATA[ Leider konnte die Nachricht nicht gespeichert werden Möglicherweise ist die Festplatte voll. ]]></Scrap>
+<Scrap id="_MASTERLOCK"><![CDATA[ Die Anfrage konnte leider nicht bearbeitet weden. Das Forum oder die Threaddatei wurde mit einer Administratorsperre versehen. ]]></Scrap>
<!--
***** Schnipsel *****
aus Grundelementen zusammengesetzt
<Variable name="docFatal">DOC_FATAL</Variable>
<Variable name="errorMessage">_ERR_MESS</Variable>
<Variable name="charNum">_NUM</Variable>
+
<Variable name="missing_key">_MANIPULATED</Variable>
<Variable name="unexpected_key">_MANIPULATED</Variable>
<Variable name="unknown_followup">_MANIPULATED</Variable>
<Variable name="name">fup</Variable>
<Variable name="maxlength">20</Variable>
<Variable name="errorType">fatal</Variable>
+ <Variable name="type">internal</Variable>
</Property>
<Property name="userID">
<Variable name="name">userid</Variable>
<Variable name="maxlength">40</Variable>
<Variable name="errorType">fatal</Variable>
+ <Variable name="type">internal</Variable>
</Property>
<Property name="uniqueID">
<Variable name="name">unid</Variable>
<Variable name="maxlength">40</Variable>
<Variable name="errorType">fatal</Variable>
+ <Variable name="type">internal</Variable>
</Property>
<Property name="quoteChar">
<Variable name="name">qchar</Variable>
<Variable name="maxlength">20</Variable>
<Variable name="errorType">fatal</Variable>
+ <Variable name="type">internal</Variable>
</Property>
<Property name="posterName">
</Property>
<Property name="posterSignature">
- <Variable name="assignValue">_FORM_SIGN_VALUE</Variable>
+ <Property name="assign">
+ <Variable name="value">_FORM_SIGN_VALUE</Variable>
+ </Property>
</Property>
<Property name="posterURL">
<Variable name="maxlength">1024</Variable>
<Variable name="type">http-url</Variable>
<Variable name="errorType">kill</Variable>
+ <Variable name="default">http://</Variable>
</Property>
<Property name="posterImage">
<Variable name="maxlength">1024</Variable>
<Variable name="type">http-url</Variable>
<Variable name="errorType">kill</Variable>
+ <Variable name="default">http://</Variable>
</Property>
</Property>
# #
# File: user/fo_posting.pl #
# #
-# Authors: André Malo <nd@o3media.de>, 2001-03-31 #
+# Authors: André Malo <nd@o3media.de>, 2001-04-08 #
# #
# Description: Accept new postings, display "Neue Nachricht" page #
# #
-# not ready, be patient please #
-# #
################################################################################
-#unknown_error
-#not_saved
-#no_option
-#occupied
-#master_lock
-#no_reply
-#dupe
-#missing_key
-#unexpected_key
-#unknown_encoding
-#unknown_followup
-#too_long
-#too_short
-#wrong_mail
-#wrong_http_url
-#wrong_url
-
use strict;
use vars qw($Bin $Shared $Script);
# response the 'new message' page
#
if ($self -> {response} -> {new_thread}) {
- my $list = [map {{$assign -> {optval} => plain($_)}} @{$formdata -> {posterCategory} -> {values}}];
+
+ # fill in the default form data
+ # and optionlist(s)
+ #
+ my $default = {};
+ for (keys %$formdata) {
+ unless (exists ($formdata -> {$_} -> {type}) and $formdata -> {$_} -> {type} eq 'internal') {
+ if (exists ($formdata -> {$_} -> {default}) and exists ($formdata -> {$_} -> {assign} -> {value})) {
+ $default -> {$formdata -> {$_} -> {assign} -> {value}}
+ = $formdata -> {$_} -> {default};
+ }
+ elsif (exists($formdata -> {$_} -> {values})) {
+ my ($_name, $val) = $_;
+ $val = exists ($formdata -> {$_} -> {default})
+ ? $formdata -> {$_} -> {default}
+ : undef;
+ $default -> {$formdata -> {$_} -> {assign} -> {value}}
+ = $self -> {template} -> list (
+ $assign -> {option},
+ [ map {
+ { $assign -> {optval} => plain($_),
+ ((defined $val and $_ eq $val)
+ ? ($assign -> {optsel} => 1)
+ : ()
+ )
+ }
+ } @{$formdata -> {$_name} -> {values}}
+ ]
+ );
+ }
+ }
+ }
print $q -> header (-type => 'text/html');
print ${$template -> scrap (
$assign -> {docNew},
{ $formdata->{uniqueID} ->{assign}->{value} => plain(unique_id),
- $formdata->{quoteChar} ->{assign}->{value} =>
- 'ÿ'.plain($self -> {conf} -> {admin} -> {View} -> {quoteChars}),
- $formdata->{posterCategory}->{assign}->{value} => $template->list ($assign -> {option}, $list),
- $formact->{post}->{assign} => $formact->{post}->{url}
+ $formdata->{quoteChar} ->{assign}->{value} => 'ÿ'.plain($self -> {conf} -> {admin} -> {View} -> {quoteChars}),
+ $formact->{post}->{assign} => $formact->{post}->{url},
},
- $pars
+ $pars,
+ $default
)};
return;
}
my $q = $self -> {cgi_object};
my $f = $self -> {forum};
my $pars = {
- author => $q -> param ($formdata -> {posterName} -> {name}),
- email => $q -> param ($formdata -> {posterEmail} -> {name}),
- category => $q -> param ($formdata -> {posterCategory} -> {name}),
- subject => $q -> param ($formdata -> {posterSubject} -> {name}),
- body => $q -> param ($formdata -> {posterBody} -> {name}),
- homepage => $q -> param ($formdata -> {posterURL} -> {name}),
- image => $q -> param ($formdata -> {posterImage} -> {name}),
quoteChars => $q -> param ($formdata -> {quoteChar} -> {name}),
uniqueID => $q -> param ($formdata -> {uniqueID} -> {name}),
time => $time,
lastMessage => $f -> {last_message},
parsedThreads => $f -> {threads},
dtd => $f -> {dtd},
- messages => $self -> {template} -> {messages}
+ messages => $self -> {template} -> {messages} || {},
};
+ # set the variables if defined..
+ #
+ my %may = (
+ author => 'posterName',
+ email => 'posterEmail',
+ category => 'posterCategory',
+ subject => 'posterSubject',
+ body => 'posterBody',
+ homepage => 'posterURL',
+ image => 'posterImage'
+ );
+
+ for (keys %may) {
+ $pars -> {$_} = $q -> param ($formdata -> {$may{$_}} -> {name})
+ if (defined $q -> param ($formdata -> {$may{$_}} -> {name}));
+ }
+
+ my ($stat, $xml, $mid);
+
+ # we've got a fup if it's a reply
+ #
if ($self -> {response} -> {reply}) {
$pars -> {parentMessage} = $self -> {fup_mid};
$pars -> {thread} = $self -> {fup_tid};
+ ($stat, $xml, $mid) = write_reply_posting ($pars);
+ }
+ else {
+ ($stat, $xml, $mid) = write_new_thread ($pars);
}
-
- my ($stat, $xml, $mid) = write_posting ($pars);
if ($stat) {
$self -> {error} = {
}
else {
$self -> {check_success} = 1;
- my $thx = $self -> {conf} -> {show_posting} -> {thanx};
+ my $thx = $self -> {conf} -> {show_posting} -> {thanx};
# define special response data
#
$self -> {response} -> {doc} = $self -> {conf} -> {assign} -> {docThx};
$self -> {response} -> {pars} = {
- $thx -> {subject} => plain ($q -> param ($formdata -> {posterSubject} -> {name})),
- $thx -> {author} => plain ($q -> param ($formdata -> {posterName} -> {name})),
- $thx -> {email} => plain ($q -> param ($formdata -> {posterEmail} -> {name})),
$thx -> {time} => plain (hr_time($time)),
$thx -> {body} => message_as_HTML (
$xml,
assign => $self -> {conf} -> {assign},
quoteChars => $q -> param ($formdata -> {quoteChar} -> {name}),
quoting => $self -> {conf} -> {admin} -> {View} -> {quoting}
- }),
- $thx -> {category} => plain ($q -> param ($formdata -> {posterCategory} -> {name})),
- $thx -> {home} => plain ($q -> param ($formdata -> {posterURL} -> {name})),
- $thx -> {image} => plain ($q -> param ($formdata -> {posterImage} -> {name}))
+ }) || ''
};
+
+ # set the variables if defined..
+ #
+ my %may = (
+ author => 'posterName',
+ email => 'posterEmail',
+ category => 'posterCategory',
+ subject => 'posterSubject',
+ homepage => 'posterURL',
+ image => 'posterImage'
+ );
+
+ for (keys %may) {
+ my $x = $q -> param ($formdata -> {$may{$_}} -> {name});
+ $x = '' unless (defined $x);
+ $self -> {response} -> {pars} -> {$thx -> {$_}} = plain ($x)
+ if (defined $thx -> {$_});
+ }
}
}
}
sub jerk {
my $text = $_[1] || 'An error has occurred.';
print <<EOF;
-Content-type: text/plain\n\n
+Content-type: text/plain
+
+
Oops.
git.p6c8.net / selfforum.git / commitdiff