X-Git-Url: https://git.p6c8.net/selfforum.git/blobdiff_plain/5eee41e4c8f4a9f494d4457c088803a260efcac3..4b55d37edde15226caac8bc1876d8d9e798587db:/selfforum-cgi/shared/Posting/_lib.pm diff --git a/selfforum-cgi/shared/Posting/_lib.pm b/selfforum-cgi/shared/Posting/_lib.pm index 05a0285..dfac468 100644 --- a/selfforum-cgi/shared/Posting/_lib.pm +++ b/selfforum-cgi/shared/Posting/_lib.pm @@ -5,7 +5,7 @@ package Posting::_lib; # File: shared/Posting/_lib.pm # # # # Authors: André Malo , 2001-03-03 # -# Frank Schoenmann , 2001-03-13 # +# Frank Schoenmann , 2001-06-02 # # # # Description: Message access interface, time format routines # # # @@ -13,9 +13,6 @@ package Posting::_lib; use strict; -use vars qw(@EXPORT_OK); -use base qw(Exporter); - use Encode::Plain; $Encode::Plain::utf8 = 1; use XML::DOM; @@ -24,36 +21,179 @@ use XML::DOM; # Export # ==================================================== -@EXPORT_OK = qw(get_message_header get_message_body get_message_node get_body_node parse_single_thread - hr_time short_hr_time long_hr_time - get_all_threads create_forum_xml_string - save_file); +use constant SORT_ASCENT => 0; # (young postings first) +use constant SORT_DESCENT => 1; +use constant KEEP_DELETED => 1; +use constant KILL_DELETED => 0; + +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 + 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 +); # ==================================================== # 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'); + $header -> appendChild ($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 ($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, @@ -74,14 +214,14 @@ sub get_message_header ($) # # 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); } @@ -94,6 +234,7 @@ sub get_body_node ($$) # # Params: $xml XML::DOM::Document Object (Document Node) # $mid Message ID +# # Return: Scalar reference # sub get_message_body ($$) @@ -113,6 +254,7 @@ 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 ($$$) @@ -120,15 +262,12 @@ 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; } @@ -137,7 +276,31 @@ sub get_message_node ($$$) } } - wantarray ? ($mnode, $tnode) : $mnode; + wantarray + ? ($mnode, $tnode) + : $mnode; +} + +### sub parse_xml_file ($) ##################################################### +# +# load the specified XML-File and create the DOM tree +# 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); + }; + + return if ($@); + + $xml; } ########################### @@ -280,37 +443,31 @@ sub sort_thread ($$) { # Params: $smsg Reference of array of references of hashs # Return: -none- # -sub delete_messages ($) -{ +sub delete_messages ($) { my $smsg = shift; - my ($z, $oldlevel, @path) = (0,0,0); - for (@$smsg) - { - if ($_ -> {'deleted'}) - { - my $n = $_ -> {'answers'} + 1; - $smsg -> [$_] -> {'answers'} -= $n for (@path); - splice @$smsg,$z,$n; + while ($z <= $#{$smsg}) { + + if ($smsg -> [$z] -> {level} > $oldlevel) { + push @path => $z; + $oldlevel = $smsg -> [$z] -> {level}; + } + elsif ($smsg -> [$z] -> {level} < $oldlevel) { + splice @path, $smsg -> [$z] -> {level}; + push @path => $z; + $oldlevel = $smsg -> [$z] -> {'level'}; + } + else { + $path[-1] = $z; } - else - { - if ($_ -> {'level'} > $oldlevel) - { - push @path,$z; - $oldlevel = $_ -> {'level'}; - } - elsif ($_ -> {'level'} < $oldlevel) - { - splice @path,$_ -> {'level'} - $oldlevel; - $oldlevel = $_ -> {'level'}; - } - else - { - $path[-1] = $z; - } + if ($smsg -> [$z] -> {deleted}) { + my $n = $smsg -> [$z] -> {answers} + 1; + $smsg -> [$_] -> {answers} -= $n for (@path); + splice @$smsg, $z, $n; + } + else { $z++; } } @@ -334,9 +491,9 @@ sub get_all_threads ($$;$) my ($last_thread, $last_message, $dtd, @unids, %threads); local (*FILE, $/); - open FILE, $file or return undef; + open FILE,"< $file" or return; my $xml = join '', ; - close(FILE) or return undef; + close(FILE) or return; if (wantarray) { @@ -364,18 +521,20 @@ sub get_all_threads ($$;$) if (defined($10)) { push @stack,$cmno if (defined $cmno); - push @msg, {mid => $1, - unid => $2, - deleted => $3, - archive => $4, - name => $5, - cat => $6, - subject => $7, - time => $8, - level => $level++, - unids => [], - kids => [], - answers => 0}; + push @msg, { + mid => $1, + unid => $2, + deleted => $3 || 0, + archive => $4 || 0, + name => $5, + cat => $6, + subject => $7, + time => $8, + level => $level++, + unids => [], + kids => [], + answers => 0 + }; if (defined $cmno) { @@ -398,18 +557,20 @@ sub get_all_threads ($$;$) } elsif (defined ($9)) { - push @msg, {mid => $1, - unid => $2, - deleted => $3, - archive => $4, - name => $5, - cat => $6, - subject => $7, - time => $8, - level => $level, - unids => [], - kids => [], - answers => 0}; + push @msg, { + mid => $1, + unid => $2, + deleted => $3 || 0, + archive => $4 || 0, + name => $5, + cat => $6, + subject => $7, + time => $8, + level => $level, + unids => [], + kids => [], + answers => 0 + }; if (defined $cmno) { @@ -543,7 +704,7 @@ sub save_file ($$) ########################### sub hr_time ($) { - my @month = (qw(Januar Februar), "M\303\244rz", qw(April Mail Juni Juli August September Oktober November Dezember)); + my @month = (qw(Januar Februar), "M\303\244rz", qw(April Mai Juni Juli August September Oktober November Dezember)); # ^^^^^^^^ - UTF8 # my (undef, $min, $hour, $day, $mon, $year) = localtime ($_[0]); @@ -558,7 +719,7 @@ sub short_hr_time ($) { } sub long_hr_time ($) { - my @month = (qw(Januar Februar), "M\303\244rz", qw(April Mail Juni Juli August September Oktober November Dezember)); + my @month = (qw(Januar Februar), "M\303\244rz", qw(April Mai Juni Juli August September Oktober November Dezember)); # ^^^^^^^^ - UTF8 # my @wday = qw(Sonntag Montag Dienstag Mittwoch Donnerstag Freitag Samstag); @@ -567,6 +728,13 @@ sub long_hr_time ($) { sprintf ('%s, %02d. %s %04d, %02d:%02d:%02d Uhr', $wday[$wday], $day, $month[$mon], $year+1900, $hour, $min, $sek); } +sub month($) { + my @month = (qw(Januar Februar), "M\303\244rz", qw(April Mai Juni Juli August September Oktober November Dezember)); + # ^^^^^^^^ - UTF8 # + + return $month[$_[0]]; +} + # ==================================================== # Modulinitialisierung # ====================================================