X-Git-Url: https://git.p6c8.net/selfforum.git/blobdiff_plain/03e918e15295c454bbcd6aa0e3a0459d99090afe..f4e905b815a97cc195eb8b8ab4703d15122ab443:/selfforum-cgi/shared/Posting/_lib.pm?ds=inline diff --git a/selfforum-cgi/shared/Posting/_lib.pm b/selfforum-cgi/shared/Posting/_lib.pm index 5136b21..0f3f015 100644 --- a/selfforum-cgi/shared/Posting/_lib.pm +++ b/selfforum-cgi/shared/Posting/_lib.pm @@ -1,46 +1,53 @@ -# Posting/_lib.pm +package Posting::_lib; -# ==================================================== -# Autor: n.d.p. / 2001-01-07 -# lm : n.d.p. / 2001-02-25 -# ==================================================== -# Funktion: -# * Schnittstellen fuer den Zugriff auf Messages -# * Zeitdarstellung -# ==================================================== +################################################################################ +# # +# File: shared/Posting/_lib.pm # +# # +# Authors: André Malo <nd@o3media.de>, 2001-03-03 # +# Frank Schoenmann <fs@tower.de>, 2001-03-13 # +# # +# Description: Message access interface, time format routines # +# # +################################################################################ use strict; -package Posting::_lib; - -use vars qw(@EXPORT_OK); -use base qw(Exporter); - use Encode::Plain; $Encode::Plain::utf8 = 1; use XML::DOM; # ==================================================== -# Funktionsexport +# Export # ==================================================== -@EXPORT_OK = qw(get_message_header get_message_body get_message_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 + 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 +); # ==================================================== -# Zugriff uebers DOM +# Access via XML::DOM # ==================================================== -########################### -# sub get_message_header +### get_message_header () ###################################################### # -# Messageheader auslesen -########################### - -sub 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) +# +sub get_message_header ($) +{ my $node = shift; my %conf; @@ -54,59 +61,109 @@ sub get_message_header ($) { my $subject = $header -> getElementsByTagName ('Subject', 0) -> item (0); my $date = $header -> getElementsByTagName ('Date', 0) -> item (0); - %conf = (name => ($name -> hasChildNodes)?$name -> getFirstChild -> getData:undef, - category => ($cat -> hasChildNodes)?$cat -> getFirstChild -> getData:undef, - subject => ($subject -> hasChildNodes)?$subject -> getFirstChild -> getData:undef, - email => (defined ($email) and $email -> hasChildNodes)?$email -> getFirstChild -> getData:undef, - home => (defined ($home) and $home -> hasChildNodes)?$home -> getFirstChild -> getData:undef, - image => (defined ($image) and $image -> hasChildNodes)?$image -> getFirstChild -> getData:undef, - time => $date -> getAttribute ('longSec')); + %conf = ( + name => ($name -> hasChildNodes)?$name -> getFirstChild -> getData:undef, + category => ($cat -> hasChildNodes)?$cat -> getFirstChild -> getData:undef, + subject => ($subject -> hasChildNodes)?$subject -> getFirstChild -> getData:undef, + email => (defined ($email) and $email -> hasChildNodes)?$email -> getFirstChild -> getData:undef, + home => (defined ($home) and $home -> hasChildNodes)?$home -> getFirstChild -> getData:undef, + image => (defined ($image) and $image -> hasChildNodes)?$image -> getFirstChild -> getData:undef, + time => $date -> getAttribute ('longSec') + ); + \%conf; } -########################### -# sub get_message_header +### get_body_node () ######################################################## # -# Messagebody auslesen -########################### +# Search a specific message body in a XML tree +# +# 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)) + { + return $_ if ($_ -> getAttribute ('mid') eq $mid); + } + + return; +} +### get_message_body () ######################################################## +# +# Read message body +# +# Params: $xml XML::DOM::Document Object (Document Node) +# $mid Message ID +# Return: Scalar reference +# sub get_message_body ($$) { - my ($xml, $mid) = @_; + my $cnode = get_body_node ($_[0], $_[1]); my $body; - foreach ($xml -> getElementsByTagName ('ContentList', 1) -> item (0) -> getElementsByTagName ('MessageContent', 0)) + $body = ($cnode -> hasChildNodes)?$cnode -> getFirstChild -> getData:'' if $cnode; + + \$body; +} + +### get_message_node () ######################################################## +# +# Search a specific message in a XML tree +# +# 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 ('mid') eq $mid) + if ($_->getAttribute ('id') eq $tid) { - $body = ($_ -> hasChildNodes)?$_ -> getFirstChild -> getData:''; + $tnode = $_; + for ($tnode -> getElementsByTagName ('Message')) + { + if ($_ -> getAttribute ('id') eq $mid) + { + $mnode = $_; + last; + } + } last; } } - \$body; + wantarray ? ($mnode, $tnode) : $mnode; } -########################### -# sub get_message_header +### sub parse_xml_file ($) ##################################################### # -# Messagenode bestimmen -########################### - -sub get_message_node ($$$) { - my ($xml,$tid,$mid) = @_; - my ($mnode,$tnode); +# 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__}; + new XML::DOM::Parser (KeepCDATA => 1) -> parsefile ($file); + }; - for ( $xml -> getElementsByTagName ('Thread')) { - if ($_ -> getAttribute ('id') eq $tid) { - $tnode = $_; - for ($tnode -> getElementsByTagName ('Message')) { - if ($_ -> getAttribute ('id') eq $mid) { - $mnode = $_; - last;}} - last;}} + return if ($@); - wantarray?($mnode, $tnode):$mnode; + $xml; } ########################### @@ -242,59 +299,77 @@ sub sort_thread ($$) { \@smsg; } -########################### -# sub delete_messages +### delete_messages () ######################################################### # -# geoeschte Nachrichten -# herausfiltern -########################### - -sub delete_messages ($) { +# Filter out deleted messages +# +# Params: $smsg Reference of array of references of hashs +# Return: -none- +# +sub delete_messages ($) +{ my $smsg = shift; my ($z, $oldlevel, @path) = (0,0,0); - for (@$smsg) { - if ($_ -> {deleted}) { - my $n = $_ -> {answers}+1; - for (@path) {$smsg -> [$_] -> {answers} -= $n;} - splice @$smsg,$z,$n;} - - else { - if ($_ -> {level} > $oldlevel) { + for (@$smsg) + { + if ($_ -> {'deleted'}) + { + my $n = $_ -> {'answers'} + 1; + $smsg -> [$_] -> {'answers'} -= $n for (@path); + splice @$smsg,$z,$n; + } + else + { + if ($_ -> {'level'} > $oldlevel) + { push @path,$z; - $oldlevel = $_ -> {level};} - - elsif ($_ -> {level} < $oldlevel) { - splice @path,$_ -> {level}-$oldlevel; - $oldlevel = $_ -> {level};} - - else { $path[-1] = $z; } - - $z++;}} + $oldlevel = $_ -> {'level'}; + } + elsif ($_ -> {'level'} < $oldlevel) + { + splice @path,$_ -> {'level'} - $oldlevel; + $oldlevel = $_ -> {'level'}; + } + else + { + $path[-1] = $z; + } + + $z++; + } + } return; } -########################### -# sub get_all_threads +### get_all_threads () ######################################################### # -# Hauptdatei laden und -# parsen -########################### - -sub get_all_threads ($$;$) { +# 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 +# list context: list (\%threads, $last_thread, $last_message, $dtd, \@unids) +# +sub get_all_threads ($$;$) +{ my ($file, $deleted, $sorted) = @_; - my ($last_thread, $last_message, @unids, %threads); - local *FILE; + my ($last_thread, $last_message, $dtd, @unids, %threads); + local (*FILE, $/); open FILE, $file or return undef; my $xml = join '', <FILE>; close(FILE) or return undef; - if (wantarray) { + if (wantarray) + { + ($dtd) = $xml =~ /<!DOCTYPE\s+\S+\s+SYSTEM\s+"([^"]+)">/; ($last_thread) = map {/(\d+)/} $xml =~ /<Forum.+?lastThread="([^"]+)"[^>]*>/; - ($last_message) = map {/(\d+)/} $xml =~ /<Forum.+?lastMessage="([^"]+)"[^>]*>/;} + ($last_message) = map {/(\d+)/} $xml =~ /<Forum.+?lastMessage="([^"]+)"[^>]*>/; + } my $reg_msg = qr~(?:</Message> |<Message\s+id="m(\d+)"\s+unid="([^"]*)"(?:\s+invisible="([^"]*)")?(?:\s+archive="([^"]*)")?[^>]*>\s* @@ -305,91 +380,95 @@ sub get_all_threads ($$;$) { <Date\s+longSec="(\d+)"[^>]*>\s* </Header>\s*(?:(<)/Message>|(?=(<)Message\s*)))~sx; - while ($xml =~ /<Thread id="t(\d+)">([^<]*(?:<(?!\/Thread>)[^<]*)*)<\/Thread>/g) { - + while ($xml =~ /<Thread id="t(\d+)">([^<]*(?:<(?!\/Thread>)[^<]*)*)<\/Thread>/g) + { my ($tid, $thread) = ($1, $2); my ($level, $cmno, @msg, @stack) = (0); - while ($thread =~ m;$reg_msg;g) { - - if (defined($10)) { + while ($thread =~ m;$reg_msg;g) + { + if (defined($10)) + { push @stack,$cmno if (defined $cmno); - push @msg, {}; - - 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}; + + if (defined $cmno) + { push @{$msg[$cmno] -> {kids}} => $#msg; - push @{$msg[$cmno] -> {unids}} => $2;} - else { - push @unids => $2;} + push @{$msg[$cmno] -> {unids}} => $2; + } + else + { + push @unids => $2; + } - for (@stack) {$msg[$_] -> {answers}++} + $msg[$_] -> {answers}++ for (@stack); $cmno=$#msg; - ($msg[-1] -> {mid}, - $msg[-1] -> {unid}, - $msg[-1] -> {name}, - $msg[-1] -> {cat}, - $msg[-1] -> {subject}, - $msg[-1] -> {time}) = ($1, $2, $5, $6, $7, $8); - - $msg[-1] -> {deleted} = $3; - $msg[-1] -> {archive} = $4; - - $msg[-1] -> {name} =~ s/&/&/g; - $msg[-1] -> {cat} =~ s/&/&/g; + $msg[-1] -> {name} =~ s/&/&/g; + $msg[-1] -> {cat} =~ s/&/&/g; $msg[-1] -> {subject} =~ s/&/&/g; - $msg[-1] -> {unids} = []; - $msg[-1] -> {kids} = []; - $msg[-1] -> {answers} = 0; - $msg[-1] -> {level} = $level++;} - - elsif (defined ($9)) { - push @msg, {}; - - if (defined $cmno) { + } + 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}; + + if (defined $cmno) + { push @{$msg[$cmno] -> {kids}} => $#msg; push @{$msg[$cmno] -> {unids}} => $2; - $msg[$cmno] -> {answers}++;} - else { - push @unids => $2;} + $msg[$cmno] -> {answers}++; + } + else + { + push @unids => $2; + } - for (@stack) {$msg[$_] -> {answers}++} + $msg[$_] -> {answers}++ for (@stack); - ($msg[-1] -> {mid}, - $msg[-1] -> {unid}, - $msg[-1] -> {name}, - $msg[-1] -> {cat}, - $msg[-1] -> {subject}, - $msg[-1] -> {time}) = ($1, $2, $5, $6, $7, $8); - - $msg[-1] -> {deleted} = $3; - $msg[-1] -> {archive} = $4; - - $msg[-1] -> {name} =~ s/&/&/g; - $msg[-1] -> {cat} =~ s/&/&/g; + $msg[-1] -> {name} =~ s/&/&/g; + $msg[-1] -> {cat} =~ s/&/&/g; $msg[-1] -> {subject} =~ s/&/&/g; + } + else + { + $cmno = pop @stack; $level--; + } + } - $msg[-1] -> {level} = $level; - $msg[-1] -> {unids} = []; - $msg[-1] -> {kids} = []; - $msg[-1] -> {answers} = 0;} - - else { - $cmno = pop @stack; $level--;}} - - # ============ - # Sortieren und bei Bedarf - # geloeschte Messages entfernen - - my $smsg = sort_thread (\@msg, $sorted); - delete_messages ($smsg) unless ($deleted); + my $smsg = sort_thread (\@msg, $sorted); # sort messages + delete_messages ($smsg) unless ($deleted); # remove invisible messages $threads{$tid} = $smsg if (@$smsg); } - wantarray?(\%threads, $last_thread, $last_message, \@unids): \%threads; + wantarray + ? (\%threads, $last_thread, $last_message, $dtd, \@unids) + : \%threads; } ########################### @@ -444,21 +523,26 @@ sub create_forum_xml_string ($$) { \$xml; } -########################### -# sub save_file +### save_file () ############################################################### # -# Datei speichern -########################### - -sub save_file ($$) { - my ($filename,$content) = @_; +# Save a file +# +# Params: $filename Filename +# $content File content as scalar reference +# Return: Status (1 - ok, 0 - error) +# +sub save_file ($$) +{ + my ($filename, $content) = @_; local *FILE; - open FILE,">$filename.temp" or return; + open FILE, ">$filename.temp" or return; - unless (print FILE $$content) { + unless (print FILE $$content) + { close FILE; - return;}; + return; + } close FILE or return; @@ -514,8 +598,4 @@ sub long_hr_time ($) { # ==================================================== # making require happy -1; - -# ==================================================== -# end of Posting::_lib -# ==================================================== \ No newline at end of file +1; \ No newline at end of file