From 408b8a7b8262c7808c79bba94f09026a9db2ac04 Mon Sep 17 00:00:00 2001 From: ndparker <> Date: Sun, 17 Jun 2001 02:21:53 +0000 Subject: [PATCH] added version checks and some comments, removed Posting::_lib::create_message_xml, fixed some issues in Posting::Cache --- selfforum-cgi/shared/Posting/Admin.pm | 110 +++++++++++------- selfforum-cgi/shared/Posting/Cache.pm | 75 +++++++++--- selfforum-cgi/shared/Posting/Write.pm | 12 +- selfforum-cgi/shared/Posting/_lib.pm | 160 ++++++++++---------------- 4 files changed, 198 insertions(+), 159 deletions(-) diff --git a/selfforum-cgi/shared/Posting/Admin.pm b/selfforum-cgi/shared/Posting/Admin.pm index f3a4330..be392e4 100644 --- a/selfforum-cgi/shared/Posting/Admin.pm +++ b/selfforum-cgi/shared/Posting/Admin.pm @@ -18,17 +18,41 @@ package Posting::Admin; ################################################################################ use strict; - -use base qw(Exporter); - -@Posting::Admin::EXPORT = qw(hide_posting recover_posting modify_posting add_user_vote level_vote); +use vars qw( + @EXPORT + $VERSION +); use Lock qw(:READ); -use Posting::_lib qw(get_message_node save_file get_all_threads - create_forum_xml_string); +use Posting::_lib qw( + get_message_node + save_file + get_all_threads + create_forum_xml_string +); use XML::DOM; +################################################################################ +# +# Version check +# +$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; + +################################################################################ +# +# Export +# +use base qw(Exporter); + +@EXPORT = qw( + hide_posting + recover_posting + modify_posting + add_user_vote + level_vote +); + ### add_user_vote () ########################################################### # # Increase number of user votes (only in thread file) @@ -41,8 +65,7 @@ use XML::DOM; # Todo: # * Lock files before modification # -sub add_user_vote() -{ +sub add_user_vote ($$$) { my ($forum, $tpath, $info) = @_; my ($tid, $mid, $percent) = ($info->{'thread'}, $info->{'posting'}, @@ -73,13 +96,14 @@ sub add_user_vote() # Todo: # * Lock files before modification # -sub level_vote -{ +sub level_vote { my ($forum, $tpath, $info´) = @_; - my ($tid, $mid, $level, $value) = ($info->{'thread'}, - $info->{'posting'}, - $info->{'level'}, - $info->{'value'}); + my ($tid, $mid, $level, $value) = ( + $info->{'thread'}, + $info->{'posting'}, + $info->{'level'}, + $info->{'value'} + ); # Thread my $tfile = $tpath . '/t' . $tid . '.xml'; @@ -89,12 +113,10 @@ sub level_vote my $mnode = get_message_node($xml, $tid, $mid); - if ($value == undef) - { + unless (defined $value) { removeAttribute($level); } - else - { + else { $mnode->setAttribute($level, $value); } @@ -114,8 +136,7 @@ sub level_vote # * set flags recursively in forum xml # * lock files before modification # -sub hide_posting($$$) -{ +sub hide_posting ($$$) { my ($forum, $tpath, $info) = @_; my ($tid, $mid, $indexFile) = ($info->{'thread'}, $info->{'posting'}, @@ -158,8 +179,7 @@ sub hide_posting($$$) # * set flags recursive in forum xml # * lock files before modification # -sub recover_posting($$$) -{ +sub recover_posting ($$$) { my ($forum, $tpath, $info) = @_; my ($tid, $mid, $indexFile) = ($info->{'thread'}, $info->{'posting'}, @@ -199,7 +219,7 @@ sub recover_posting($$$) # $invisible 1 - invisible, 0 - visible # Return: Status code # -sub change_posting_visibility($$$$) +sub change_posting_visibility ($$$$) { my ($fname, $tid, $mid, $invisible) = @_; @@ -211,8 +231,7 @@ sub change_posting_visibility($$$$) $mnode->setAttribute('invisible', $invisible); # Set flag in sub nodes - for ($mnode->getElementsByTagName('Message')) - { + for ($mnode->getElementsByTagName('Message')) { $_->setAttribute('invisible', $invisible); } @@ -229,14 +248,20 @@ sub change_posting_visibility($$$$) # (data = \%hashref: 'subject', 'category', 'body') # Return: -none- # -sub modify_posting($$$) -{ +sub modify_posting($$$) { my ($forum, $tpath, $info) = @_; - my ($tid, $mid, $indexFile, $data) = ($info->{'thread'}, - $info->{'posting'}, - $info->{'indexFile'}, - $info->{'data'}); - my ($subject, $category, $body) = ($data->{'subject'}, $data->{'category'}, $data->{'body'}); + my ($tid, $mid, $indexFile, $data) = ( + $info->{'thread'}, + $info->{'posting'}, + $info->{'indexFile'}, + $info->{'data'} + ); + + my ($subject, $category, $body) = ( + $data->{'subject'}, + $data->{'category'}, + $data->{'body'} + ); my %msgdata; @@ -250,14 +275,11 @@ sub modify_posting($$$) $body && change_posting_body($tfile, 't'.$tid, 'm'.$mid, $body); # Forum (does not contain msg bodies) - if ($subject or $category) - { + if ($subject or $category) { my ($f, $lthread, $lmsg, $dtd, $zlev) = get_all_threads($forum, 1, 0); - for (@{$f->{$tid}}) - { - if ($_->{'mid'} == $mid) - { + for (@{$f->{$tid}}) { + if ($_->{'mid'} == $mid) { $subject && $_->{'subject'} = $subject; $category && $_->{'cat'} = $category; } @@ -282,8 +304,7 @@ sub modify_posting($$$) # \%values New values # Return: Status code # -sub change_posting_value($$$$) -{ +sub change_posting_value($$$$) { my ($fname, $tid, $mid, $values) = @_; my $parser = new XML::DOM::Parser; @@ -315,8 +336,7 @@ sub change_posting_value($$$$) # Todo: # * Change body # -sub change_posting_body($$$$) -{ +sub change_posting_body ($$$$) { my ($fname, $tid, $mid, $body) = @_; my $parser = new XML::DOM::Parser; @@ -331,4 +351,8 @@ sub change_posting_body($$$$) # Let it be true -1; \ No newline at end of file +1; + +# +# +### end of Posting::Admin ###################################################### diff --git a/selfforum-cgi/shared/Posting/Cache.pm b/selfforum-cgi/shared/Posting/Cache.pm index d937b9d..cf8c3c4 100644 --- a/selfforum-cgi/shared/Posting/Cache.pm +++ b/selfforum-cgi/shared/Posting/Cache.pm @@ -11,11 +11,20 @@ package Posting::Cache; ################################################################################ use strict; +use vars qw( + $VERSION +); use Fcntl; use File::Path; use Lock qw(:ALL); +################################################################################ +# +# Version check +# +$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; + my $O_BINARY = eval "O_BINARY"; $O_BINARY = 0 if ($@); @@ -148,6 +157,8 @@ sub r_garbage_collection { local $/; local $\; + return; # no GC yet + seek $handle, 0, 0 or return; read ($handle, $buf, $len) or return; for (0..$num) { @@ -220,6 +231,8 @@ sub r_add_view { read ($handle, $buf, $reclen) == $reclen or return; my ($posting, $thread, $views, $votings) = unpack 'L4' => $buf; + $thread == 0xFFFFFFFF and $thread = $param->{thread}; + $param->{thread} == $thread or return; $param->{posting} == $posting or return; @@ -262,6 +275,8 @@ sub r_pick { read ($handle, $buf, $reclen) == $reclen or return; my ($posting, $thread, $views, $votings) = unpack 'L4' => $buf; + $thread == 0xFFFFFFFF and $thread = $param->{thread}; + $param->{thread} == $thread or return; $param->{posting} == $posting or return; @@ -279,7 +294,7 @@ sub r_pick { time => $_->[0] || 0, IP => $_->[1] || 0 } - } [split ' '] + } [split ' ' => $_,3] } @records } }; @@ -344,7 +359,6 @@ sub add_voting { $self -> vote_wrap ( \&r_add_voting, - $self->cachefile($param), $param ); } @@ -359,6 +373,8 @@ sub r_add_voting { read ($handle, $buf, $reclen) == $reclen or return; my ($posting, $thread, $views, $votings) = unpack 'L4' => $buf; + $thread == 0xFFFFFFFF and $thread = $param->{thread}; + $param->{thread} == $thread or return; { @@ -420,7 +436,7 @@ sub r_add_posting { while (++$z < $param->{posting}) { seek $handle, 0, 2 or return; print $handle pack( - 'L4' => $z, 0, 0, 0 + 'L4' => $z, 0xFFFFFFFF, 0, 0 ) or return; } $z = undef; @@ -500,30 +516,53 @@ sub add_wrap { # Return: Status code (Bool) # sub vote_wrap { - my ($self, $gosub, $filename, @param) = @_; + my ($self, $gosub, $param) = @_; my $status; - unless (write_lock_file ($filename)) { - violent_unlock_file ($filename); - $self->set_error ('could not write-lock cache file '.$filename); + unless (write_lock_file ($self->summaryfile)) { + violent_unlock_file ($self->summaryfile); + $self->set_error ('could not write-lock summary file '.$self->summaryfile); } else { - local *CACHE; - unless (sysopen (CACHE, $filename, O_APPEND | O_CREAT | O_RDWR)) { - $self->set_error ('could not open to read/write/append cache file '.$filename); + local *S; + unless (sysopen (S, $self->summaryfile, O_RDWR | $O_BINARY)) { + $self->set_error ('could not open to read/write summary file '.$self->summaryfile); } else { - $status = $self -> mod_wrap ( - $gosub, - \*CACHE, - @param - ); - unless (close CACHE) { + unless (-d $self->threaddir($param)) { + mkdir $self->threaddir($param) or return; + } + my $filename = $self->cachefile($param); + + unless (write_lock_file ($filename)) { + violent_unlock_file ($filename); + $self->set_error ('could not write-lock cache file '.$filename); + } + else { + local *CACHE; + unless (sysopen (CACHE, $filename, O_APPEND | O_CREAT | O_RDWR)) { + $self->set_error ('could not open to read/write/append cache file '.$filename); + } + else { + $status = $gosub -> ( + $self, + \*S, + \*CACHE, + $param + ); + unless (close CACHE) { + $status=0; + $self->set_error('could not close cache file '.$filename); + } + } + violent_unlock_file ($filename) unless (write_unlock_file ($filename)); + } + unless (close S) { $status=0; - $self->set_error('could not close cache file '.$filename); + $self->set_error('could not close summary file '.$self->summaryfile); } } - violent_unlock_file ($filename) unless (write_unlock_file ($filename)); + violent_unlock_file ($self->summaryfile) unless (write_unlock_file ($self->summaryfile)); } # return diff --git a/selfforum-cgi/shared/Posting/Write.pm b/selfforum-cgi/shared/Posting/Write.pm index 98f71fe..b7338f6 100644 --- a/selfforum-cgi/shared/Posting/Write.pm +++ b/selfforum-cgi/shared/Posting/Write.pm @@ -11,7 +11,11 @@ package Posting::Write; ################################################################################ use strict; -use vars qw(%error @EXPORT); +use vars qw( + %error + @EXPORT + $VERSION +); use Encode::Plain; $Encode::Plain::utf8 = 1; use Encode::Posting; @@ -39,6 +43,12 @@ use XML::DOM; noParent => '4 could not find parent message' ); +################################################################################ +# +# Version check +# +$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; + ################################################################################ # # Export diff --git a/selfforum-cgi/shared/Posting/_lib.pm b/selfforum-cgi/shared/Posting/_lib.pm index 8c1364d..4ca1514 100644 --- a/selfforum-cgi/shared/Posting/_lib.pm +++ b/selfforum-cgi/shared/Posting/_lib.pm @@ -12,23 +12,33 @@ package Posting::_lib; ################################################################################ use strict; +use vars qw( + @EXPORT_OK + $VERSION +); use Encode::Plain; $Encode::Plain::utf8 = 1; use Time::German; 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 @@ -55,9 +65,10 @@ use base qw(Exporter); KILL_DELETED ); -# ==================================================== +################################################################################ +# # Access via XML::DOM -# ==================================================== +# ### sub create_message ($$) #################################################### # @@ -306,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); @@ -320,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; } @@ -746,4 +712,4 @@ sub very_short_hr_time($) { # # -### end of Posting::_lib ####################################################### +### end of Posting::_lib ####################################################### \ No newline at end of file -- 2.34.1