X-Git-Url: https://git.p6c8.net/selfforum.git/blobdiff_plain/84497798a93953681eec330e3fc98068adbff4d4..f91793544f0d5c7f978e5cf6214d9882d7c4db7c:/selfforum-cgi/shared/Posting/_lib.pm diff --git a/selfforum-cgi/shared/Posting/_lib.pm b/selfforum-cgi/shared/Posting/_lib.pm index 8c1364d..83439c5 100644 --- a/selfforum-cgi/shared/Posting/_lib.pm +++ b/selfforum-cgi/shared/Posting/_lib.pm @@ -4,31 +4,46 @@ package Posting::_lib; # # # File: shared/Posting/_lib.pm # # # -# Authors: André Malo , 2001-06-11 # -# Frank Schoenmann , 2001-06-04 # +# Authors: André Malo # +# Frank Schönmann # # # # Description: Message access interface, time format routines # # # ################################################################################ use strict; +use vars qw( + @EXPORT_OK +); use Encode::Plain; $Encode::Plain::utf8 = 1; -use Time::German; +use Time::German qw(localtime); use XML::DOM; -# ==================================================== -# Export -# ==================================================== +################################################################################ +# +# Version check +# +# last modified: +# $Date$ (GMT) +# by $Author$ +# +sub VERSION {(q$Revision$ =~ /([\d.]+)\s*$/)[0] or '0.0'} -use constant SORT_ASCENT => 0; # (young postings first) +################################################################################ +# +# Export +# +use constant SORT_ASCENT => 0; # (latest postings first) use constant SORT_DESCENT => 1; use constant KEEP_DELETED => 1; use constant KILL_DELETED => 0; +use constant FORUM_DTD => 'http://selfforum.sourceforge.net/dtd/forum.dtd'; + use base qw(Exporter); -@Posting::_lib::EXPORT_OK = qw( +@EXPORT_OK = qw( get_message_header get_message_body get_message_node @@ -55,9 +70,10 @@ use base qw(Exporter); KILL_DELETED ); -# ==================================================== +################################################################################ +# # Access via XML::DOM -# ==================================================== +# ### sub create_message ($$) #################################################### # @@ -121,7 +137,7 @@ sub create_message ($$) { # create a XML::DOM::Document object of a thread containing one posting # # Params: hash reference -# (dtd, thread, msg, body, ip, name, email, home, +# (thread, msg, body, ip, name, email, home, # image, category, subject, time) # # Return: XML::DOM::Document object @@ -142,7 +158,7 @@ sub create_new_thread ($) { # set doctype # - my $dtd = $xml -> createDocumentType ('Forum' => $par -> {dtd}); + my $dtd = $xml -> createDocumentType ('Forum' => FORUM_DTD); $xml -> setDoctype ($dtd); # create root element 'Forum' @@ -306,13 +322,16 @@ sub parse_xml_file ($) { $xml; } -########################### -# sub parse_single_thread +### parse_single_thread () ##################################################### +# +# parse a thread file +# +# Params: $tnode - Thread element node +# $deleted - keep deleted (boolean) +# $sorted - sorting order +# +# Return: arrayref # -# einzelne Threaddatei -# parsen -########################### - sub parse_single_thread ($$;$) { my ($tnode, $deleted, $sorted) = @_; my ($header, @msg, %mno); @@ -320,122 +339,75 @@ sub parse_single_thread ($$;$) { for ($tnode -> getElementsByTagName ('Message')) { $header = get_message_header ($_); - push @msg,{mid => ($_ -> getAttribute ('id') =~ /(\d+)/)[0], - ip => $_ -> getAttribute ('ip'), - kids => [$_ -> getElementsByTagName ('Message', 0)], - answers => $_ -> getElementsByTagName ('Message') -> getLength, - deleted => $_ -> getAttribute ('invisible'), - archive => $_ -> getAttribute ('archive'), - name => plain($header -> {name}), - cat => plain($header -> {category} or ''), - subject => plain($header -> {subject}), - time => plain($header -> {time})}; - $mno{$_} = $#msg;} - - # Eintraege ergaenzen und korrigieren + push @msg => { + mid => ($_ -> getAttribute ('id') =~ /(\d+)/)[0], + ip => $_ -> getAttribute ('ip'), + kids => [$_ -> getElementsByTagName ('Message', 0)], + answers => $_ -> getElementsByTagName ('Message') -> getLength, + deleted => $_ -> getAttribute ('invisible'), + archive => $_ -> getAttribute ('archive'), + name => plain($header -> {name}), + cat => plain($header -> {category} or ''), + subject => plain($header -> {subject}), + time => plain($header -> {time}) + }; + $mno{$_} = $#msg; + } + my $level; $msg[0] -> {level} = 0; for (@msg) { $level = $_ -> {level} + 1; - @{$_ -> {kids}} = map {$msg[$mno{$_}] -> {level} = $level; $mno{$_}} @{$_ -> {kids}};} - - # ============ - # Sortieren und bei Bedarf - # geloeschte Messages entfernen + @{$_ -> {kids}} = map {$msg[$mno{$_}] -> {level} = $level; $mno{$_}} @{$_ -> {kids}}; + } + # sort and process deleted files + # my $smsg = sort_thread (\@msg, $sorted); delete_messages ($smsg) unless ($deleted); $smsg; } -########################### -# sub create_message_xml +################################################################################ # -# Message-XML-String -# erzeugen -########################### - -sub create_message_xml ($$$) { - my ($xml, $msges, $num) = @_; - - my $msg = $msges -> [$num]; - - my $message = $xml -> createElement ('Message'); - $message -> setAttribute ('id', 'm'.$msg -> {mid}); - $message -> setAttribute ('invisible', '1') if ($msg -> {deleted}); - $message -> setAttribute ('archive', '1') if ($msg -> {archive}); - - # Header erzeugen - my $header = $xml -> createElement ('Header'); - - # alles inside of 'Header' - my $author = $xml -> createElement ('Author'); - - my $name = $xml -> createElement ('Name'); - $name -> addText (toUTF8($msg -> {name})); - - my $email = $xml -> createElement ('Email'); - - my $category = $xml -> createElement ('Category'); - $category -> addText (toUTF8($msg -> {cat})); - - my $subject = $xml -> createElement ('Subject'); - $subject -> addText (toUTF8($msg -> {subject})); - - my $date = $xml -> createElement ('Date'); - $date -> setAttribute ('longSec', $msg -> {time}); - - $author -> appendChild ($name); - $author -> appendChild ($email); - $header -> appendChild ($author); - $header -> appendChild ($category); - $header -> appendChild ($subject); - $header -> appendChild ($date); - $message -> appendChild ($header); - - if ($msg -> {kids}) { - for (@{$msg -> {kids}}) { - $message -> appendChild (&create_message_xml ($xml, $msges, $_)); - } - } - - $message; -} - -# ==================================================== -# XML-Parsen von Hand -# ==================================================== - -########################### -# sub sort_thread +# Access via regexps and native perl ;) # -# Messages eines -# Threads sortieren -########################### +### sort_thread () ############################################################# +# +# sort the message array +# +# Params: $msg - arrayref +# $sorted - sorting order +# +# Return: sorted arrayref +# sub sort_thread ($$) { my ($msg, $sorted) = @_; my ($z, %mhash) = (0); - if ($sorted) { # aelteste zuerst + if ($sorted) { # oldest first for (@$msg) { @$msg[@{$_ -> {kids}}] = sort {$a -> {mid} <=> $b -> {mid}} @$msg[@{$_ -> {kids}}] if (@{$_ -> {kids}} > 1); $mhash{$_ -> {mid}} = [@$msg[@{$_ -> {kids}}]];}} - else { # juengste zuerst + else { # latest first for (@$msg) { @$msg[@{$_ -> {kids}}] = sort {$b -> {mid} <=> $a -> {mid}} @$msg[@{$_ -> {kids}}] if (@{$_ -> {kids}} > 1); $mhash{$_ -> {mid}} = [@$msg[@{$_ -> {kids}}]];}} - # Kinder wieder richtig einsortieren + # sort the children + # my @smsg = ($msg -> [0]); for (@smsg) { ++$z; splice @smsg,$z,0,@{$mhash{$_ -> {mid}}} if ($_ -> {answers}); - delete $_ -> {kids};} + delete $_ -> {kids}; + } + # return \@smsg; } @@ -499,13 +471,13 @@ sub get_all_threads ($$;$) { close(FILE) or return; if (wantarray) { - ($dtd) = $xml =~ //; + $dtd = FORUM_DTD; ($last_thread) = map {/(\d+)/} $xml =~ /]*>/; ($last_message) = map {/(\d+)/} $xml =~ /]*>/; } my $reg_msg = qr~(?: - |]*>\s* + |]*>\s*
[^<]*(?:<(?!Name>)[^<]*)* ([^<]+)[^<]*(?:<(?!Category>)[^<]*)* ([^<]*)\s* @@ -525,7 +497,7 @@ sub get_all_threads ($$;$) { push @stack,$cmno if (defined $cmno); push @msg, { mid => $1, - unid => $2, + unid => (defined $2) ? $2 : '', deleted => $3 || 0, archive => $4 || 0, name => $5, @@ -541,11 +513,11 @@ sub get_all_threads ($$;$) { if (defined $cmno) { push @{$msg[$cmno] -> {kids}} => $#msg; - push @{$msg[$cmno] -> {unids}} => $2; + push @{$msg[$cmno] -> {unids}} => (defined $2) ? $2 : '#'; } else { - push @unids => $2; + push @unids => (defined $2) ? $2 : ''; } $msg[$_] -> {answers}++ for (@stack); @@ -561,7 +533,7 @@ sub get_all_threads ($$;$) { { push @msg, { mid => $1, - unid => $2, + unid => (defined $2) ? $2 : '', deleted => $3 || 0, archive => $4 || 0, name => $5, @@ -577,12 +549,12 @@ sub get_all_threads ($$;$) { if (defined $cmno) { push @{$msg[$cmno] -> {kids}} => $#msg; - push @{$msg[$cmno] -> {unids}} => $2; + push @{$msg[$cmno] -> {unids}} => (defined $2) ? $2 : ''; $msg[$cmno] -> {answers}++; } else { - push @unids => $2; + push @unids => (defined $2) ? $2 : ''; } $msg[$_] -> {answers}++ for (@stack); @@ -622,9 +594,9 @@ sub create_forum_xml_string ($$) { my ($level, $thread, $msg); my $xml = - ''."\n" - . ' {dtd}.'">'."\n" - . ''; + ''."\n" + . ''."\n" + . ''; for $thread (sort {$b <=> $a} keys %$threads) { $xml .= ''; @@ -636,7 +608,7 @@ sub create_forum_xml_string ($$) { $level = $msg -> {level}; $xml .= ' {unid}) ?' unid="'.$msg -> {unid}.'"':'') . (($msg -> {deleted})?' invisible="1"':'') . (($msg -> {archive})?' archive="1"':'') . '>' @@ -717,26 +689,26 @@ sub month($) { } sub hr_time ($) { - my (undef, $min, $hour, $day, $mon, $year) = germantime (shift); + my (undef, $min, $hour, $day, $mon, $year) = localtime (shift); sprintf ('%02d. %s %04d, %02d:%02d Uhr', $day, month($mon+1), $year+1900, $hour, $min); } sub short_hr_time ($) { - my (undef, $min, $hour, $day, $mon, $year) = germantime (shift); + my (undef, $min, $hour, $day, $mon, $year) = localtime (shift); sprintf ('%02d. %02d. %04d, %02d:%02d Uhr', $day, $mon+1, $year+1900, $hour, $min); } sub long_hr_time ($) { my @wday = qw(Sonntag Montag Dienstag Mittwoch Donnerstag Freitag Samstag); - my ($sek, $min, $hour, $day, $mon, $year, $wday) = germantime (shift); + my ($sek, $min, $hour, $day, $mon, $year, $wday) = localtime (shift); sprintf ('%s, %02d. %s %04d, %02d:%02d:%02d Uhr', $wday[$wday], $day, month($mon+1), $year+1900, $hour, $min, $sek); } sub very_short_hr_time($) { - my (undef, $min, $hour, $day, $mon, $year) = germantime (shift); + my (undef, $min, $hour, $day, $mon, $year) = localtime (shift); sprintf ('%02d. %02d. %04d', $day, $mon+1, $year+1900); } @@ -746,4 +718,4 @@ sub very_short_hr_time($) { # # -### end of Posting::_lib ####################################################### +### end of Posting::_lib ####################################################### \ No newline at end of file