X-Git-Url: https://git.p6c8.net/selfforum.git/blobdiff_plain/8f99a6e4fd14417d4724241f30d154abdc27e789..1212b3c6efe671f3c4e7d88eddb0a543609fe610:/selfforum-cgi/shared/Posting/_lib.pm diff --git a/selfforum-cgi/shared/Posting/_lib.pm b/selfforum-cgi/shared/Posting/_lib.pm index 94f6af4..e89a0c1 100644 --- a/selfforum-cgi/shared/Posting/_lib.pm +++ b/selfforum-cgi/shared/Posting/_lib.pm @@ -4,30 +4,41 @@ package Posting::_lib; # # # File: shared/Posting/_lib.pm # # # -# Authors: André Malo , 2001-03-03 # -# Frank Schoenmann , 2001-03-13 # +# Authors: André Malo , 2001-06-11 # +# Frank Schoenmann , 2001-06-04 # # # # Description: Message access interface, time format routines # # # ################################################################################ use strict; +use vars qw( + @EXPORT_OK + $VERSION +); use Encode::Plain; $Encode::Plain::utf8 = 1; +use Time::German ':overwrite_internal_localtime'; use XML::DOM; -# ==================================================== -# Export -# ==================================================== +################################################################################ +# +# Version check +# +$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; -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 base qw(Exporter); -@Posting::_lib::EXPORT_OK = qw( +@EXPORT_OK = qw( get_message_header get_message_body get_message_node @@ -40,6 +51,8 @@ use base qw(Exporter); hr_time short_hr_time long_hr_time + very_short_hr_time + month get_all_threads create_forum_xml_string @@ -52,9 +65,10 @@ use base qw(Exporter); KILL_DELETED ); -# ==================================================== +################################################################################ +# # Access via XML::DOM -# ==================================================== +# ### sub create_message ($$) #################################################### # @@ -295,7 +309,7 @@ sub parse_xml_file ($) { my $xml = eval { local $SIG{__DIE__}; # CGI::Carp works unreliable ;-( - new XML::DOM::Parser (KeepCDATA => 1) -> parsefile ($file); + new XML::DOM::Parser(KeepCDATA => 1)->parsefile ($file); }; return if ($@); @@ -303,13 +317,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); @@ -317,122 +334,74 @@ 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};} + # return \@smsg; } @@ -443,37 +412,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++; } } @@ -485,24 +448,23 @@ sub delete_messages ($) # # Read and Parse the main file (without any XML-module, they are too slow) # -# Params: $file /path/to/filename of the main file -# $deleted hold deleted (invisible) messages in result (1) oder not (0) -# $sorted direction of message sort: descending (0) (default) or ascending (1) -# Return: scalar context: hash reference +# Params: $file - /path/to/filename of the main file +# $deleted - hold deleted (invisible) messages in result (1) oder not (0) +# $sorted - direction of message sort: descending (0) (default) or ascending (1) +# +# Return: scalar context: hash reference (\%threads) # list context: list (\%threads, $last_thread, $last_message, $dtd, \@unids) # -sub get_all_threads ($$;$) -{ +sub get_all_threads ($$;$) { my ($file, $deleted, $sorted) = @_; 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) - { + if (wantarray) { ($dtd) = $xml =~ //; ($last_thread) = map {/(\d+)/} $xml =~ /]*>/; ($last_message) = map {/(\d+)/} $xml =~ /]*>/; @@ -527,18 +489,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) { @@ -561,18 +525,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) { @@ -608,49 +574,56 @@ sub get_all_threads ($$;$) : \%threads; } -########################### -# sub create_forum_xml_string +### create_forum_xml_string () ################################################# +# +# compose main file xml string +# +# Params: $threads - parsed threads (see also 'get_all_threads') +# $params - hashref (see doc for details) +# +# Return: scalarref of the xml string # -# Forumshauptdatei erzeugen -########################### - sub create_forum_xml_string ($$) { my ($threads, $param) = @_; my ($level, $thread, $msg); - my $xml = ''."\n" - .' {dtd}.'">'."\n" - .''; + my $xml = + ''."\n" + . ' {dtd}.'">'."\n" + . ''; - foreach $thread (sort {$b <=> $a} keys %$threads) { + for $thread (sort {$b <=> $a} keys %$threads) { $xml .= ''; $level = -1; - foreach $msg (@{$threads -> {$thread}}) { - $xml .= '' x ($level - $msg -> {level} + 1) if ($msg -> {level} <= $level); + for $msg (@{$threads -> {$thread}}) { + $xml .= '' x ($level - $msg -> {level} + 1) if ($msg -> {level} <= $level); + $level = $msg -> {level}; - $xml .= ' {deleted})?' invisible="1"':'') - .(($msg -> {archive})?' archive="1"':'') - .'>' - .'
' - .'' - .'' - .plain($msg -> {name}) - .'' - .'' - .'' - .'' - .((length $msg -> {cat})?plain($msg -> {cat}):'') - .'' - .'' - .plain($msg -> {subject}) - .'' - .'' - .'
';} + $xml .= + ' {deleted})?' invisible="1"':'') + . (($msg -> {archive})?' archive="1"':'') + . '>' + . '
' + . '' + . '' + . plain($msg -> {name}) + . '' + . '' + . '' + . '' + . ((length $msg -> {cat})?plain($msg -> {cat}):'') + . '' + . '' + . plain($msg -> {subject}) + . '' + . '' + . '
'; + } $xml .= '' x ($level + 1); $xml .= '';} @@ -688,51 +661,55 @@ sub save_file ($$) 1; } -# ==================================================== -# Zeitdarstellung -# ==================================================== - -########################### -# sub hr_time +################################################################################ +# +# several time formatting routines +# +# hr_time # 02. Januar 2001, 12:02 Uhr # -# sub short_hr_time +# short_hr_time # 02. 01. 2001, 12:02 Uhr # -# sub long_hr_time +# long_hr_time # Dienstag, 02. Januar 2001, 12:02:01 Uhr # -# formatierte Zeitangabe -########################### +# very_short_hr_time +# 02. 01. 2001 +# +sub month($) { + (qw(Januar Februar), "M\303\244rz", qw(April Mai Juni Juli August September Oktober November Dezember))[shift (@_) - 1]; + # ^^^^^^^^ - UTF8 # +} sub hr_time ($) { - my @month = (qw(Januar Februar), "M\303\244rz", qw(April Mail Juni Juli August September Oktober November Dezember)); - # ^^^^^^^^ - UTF8 # + my (undef, $min, $hour, $day, $mon, $year) = localtime (shift); - my (undef, $min, $hour, $day, $mon, $year) = localtime ($_[0]); - - sprintf ('%02d. %s %04d, %02d:%02d Uhr', $day, $month[$mon], $year+1900, $hour, $min); + 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) = localtime ($_[0]); + 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 @month = (qw(Januar Februar), "M\303\244rz", qw(April Mail Juni Juli August September Oktober November Dezember)); - # ^^^^^^^^ - UTF8 # - my @wday = qw(Sonntag Montag Dienstag Mittwoch Donnerstag Freitag Samstag); - my ($sek, $min, $hour, $day, $mon, $year, $wday) = localtime ($_[0]); + my ($sek, $min, $hour, $day, $mon, $year, $wday) = localtime (shift); - sprintf ('%s, %02d. %s %04d, %02d:%02d:%02d Uhr', $wday[$wday], $day, $month[$mon], $year+1900, $hour, $min, $sek); + sprintf ('%s, %02d. %s %04d, %02d:%02d:%02d Uhr', $wday[$wday], $day, month($mon+1), $year+1900, $hour, $min, $sek); } -# ==================================================== -# Modulinitialisierung -# ==================================================== +sub very_short_hr_time($) { + my (undef, $min, $hour, $day, $mon, $year) = localtime (shift); -# making require happy -1; \ No newline at end of file + sprintf ('%02d. %02d. %04d', $day, $mon+1, $year+1900); +} + +# keep 'require' happy +1; + +# +# +### end of Posting::_lib ####################################################### \ No newline at end of file