--- /dev/null
+package Arc::Archive;
+
+################################################################################
+# #
+# File: shared/Arc/Archive.pm #
+# #
+# Authors: Andre Malo <nd@o3media.de>, 2001-04-29 #
+# #
+# Description: Severance of Threads and archiving #
+# #
+################################################################################
+
+use strict;
+
+use Arc::Test;
+use Lock qw(:ALL);
+use Posting::_lib qw(
+ get_all_threads
+ create_forum_xml_string
+ parse_xml_file
+ parse_single_thread
+ get_message_node
+ get_body_node
+ save_file
+ KEEP_DELETED
+);
+use Posting::Cache;
+
+use XML::DOM;
+
+################################################################################
+#
+# Export
+#
+use base qw(Exporter);
+@Arc::Archive::EXPORT = qw(cut_tail);
+
+### sub cut_tail ($) ###########################################################
+#
+# shorten the main file and archive, if necessary
+#
+# Params: $param - hash reference
+# (forumFile, messagePath, archivePath, lockFile, adminDefault,
+# cachePath)
+#
+# Return: hash reference - empty if all right done
+#
+sub cut_tail ($) {
+ my $param = shift;
+ my %failed;
+
+ if ( $param->{adminDefault}->{Severance}->{severance} ne 'instant'
+ or $param->{adminDefault}->{Instant}->{execute}
+ ) {
+ if (write_lock_file($param->{lockFile}, 1)) {
+ if (write_lock_file ($param->{forumFile})) {
+ my (
+ $threads,
+ $last_thread,
+ $last_message,
+ $dtd,
+ undef
+ ) = get_all_threads ($param->{forumFile}, KEEP_DELETED);
+
+ my $obsolete = get_obsolete_threads ({
+ parsedThreads => $threads,
+ adminDefault => $param->{adminDefault}
+ });
+
+ delete $threads->{$_} for (@$obsolete);
+
+ my $saved = save_file (
+ $param -> {forumFile},
+ create_forum_xml_string (
+ $threads,
+ { dtd => $dtd,
+ lastMessage => $last_message,
+ lastThread => $last_thread
+ }
+ )
+ );
+ if ($saved) {
+ for (@$obsolete) {
+ set_master_lock ($param->{messagePath}."t$_.xml") or $failed{$_} = 'could not set master lock';
+ }
+ }
+ violent_unlock_file ($param->{forumFile}) unless (write_unlock_file ($param->{forumFile}));
+
+ if ($saved) {
+ # now process thread files
+ #
+ my $sev_opt = ($param -> {adminDefault} -> {Severance} -> {severance} eq 'instant')
+ ? $param -> {adminDefault} -> {Instant} -> {Severance}
+ : ($param -> {adminDefault} -> {Severance});
+
+ my $cache = new Posting::Cache ($param->{cachePath});
+
+ if ($sev_opt->{exArchiving}) {
+ # yes, we cut & archive
+ #
+ my $sum = $cache -> summary;
+ if ($sum) {
+ for my $tid (grep {not exists ($failed{$_})} @$obsolete) {
+ my $xml = parse_xml_file ($param->{messagePath}."t$tid.xml");
+ unless ($xml) {
+ $failed{$tid} = 'could not parse thread file.';
+ }
+ else {
+ my $tnode = $xml -> getElementsByTagName ('Thread') -> item(0);
+ my $msg = parse_single_thread ($tnode, KEEP_DELETED);
+
+ if ($sev_opt->{archiving} eq 'UserVotings') {
+ # filter out the bad stuff
+ #
+ my $percent = $param->{adminDefault}->{Voting}->{Limit};
+ my ($oldlevel, @path, $z, %archive) = (0, 0);
+
+ for $z (0..$#{$msg}) {
+ if ($msg -> [$z] -> {level} > $oldlevel) {
+ push @path => $z;
+ $oldlevel = $msg -> [$z] -> {level};
+ }
+ elsif ($msg -> [$z] -> {level} < $oldlevel) {
+ splice @path, $msg -> [$z] -> {level};
+ push @path => $z;
+ $oldlevel = $msg -> [$z] -> {level};
+ }
+ else {
+ $path[-1] = $z;
+ }
+
+ if (defined $msg->[$z]->{archive}) {
+ if ($msg->[$z]->{archive}) {
+ $archive{$msg->[$_]->{mid}} = 1 for (@path);
+ }
+ }
+ unless ($msg->[$z]->{archive} or $msg->[$z]->{deleted}) {
+ my $key = $sum->{$tid}->{$msg->[$z]->{mid}};
+ if ($percent == 0 or ($key->{views} and ($key->{votings} * 100 / $key->{views}) >= $percent)) {
+ $archive{$msg->[$_]->{mid}} = 1 for (@path);
+ }
+ }
+ }
+
+ # now filter out
+ #
+ for (reverse grep {!$archive{$_->{mid}}} @$msg) {
+ my $h = get_message_node($xml, "t$tid", 'm'.$_->{mid});
+ $h -> getParentNode -> removeChild ($h);
+
+ $h = get_body_node($xml, 'm'.$_->{mid});
+ $h -> getParentNode -> removeChild ($h);
+ }
+ }
+ # save back xml file (into archive)
+ #
+ if ($tnode -> hasChildNodes) {
+ # insert views and votings counter
+ #
+ for ($tnode -> getElementsByTagName ('Message')) {
+ my ($id) = $_ -> getAttribute ('id') =~ /(\d+)/;
+ $_ -> setAttribute ('views' => $sum->{$tid}->{$id}->{views});
+ $_ -> setAttribute ('votings' => $sum->{$tid}->{$id}->{votings});
+ }
+
+ my ($month, $year) = (localtime ($msg->[0]->{time}))[4,5];
+ $month++; $year+=1900;
+ my $yeardir = $param -> {archivePath} . $year;
+ my $yearpath = $yeardir . '/';
+ my $monthdir = $yearpath . $month;
+ my $monthpath = $monthdir . '/';
+ my $file = $monthpath . "t$tid.xml";
+
+ mkdir $yeardir unless (-d $yeardir);
+ if (-d $yeardir) {
+ mkdir $monthdir unless (-d $monthdir);
+ if (-d $monthdir) {
+ save_file (
+ $file,
+ \($xml -> toString)
+ ) or $failed{$tid} = "could not save '$file'";
+ }
+ else {
+ $failed{$tid} = "could not create directory '$monthdir'";
+ }
+ }
+ else {
+ $failed{$tid} = "could not create directory '$yeardir'";
+ }
+ }
+
+ }
+ }
+ }
+ else {
+ @failed{@$obsolete} = 'could not load summary';
+ }
+ }
+ # delete processed files
+ #
+ for (grep {not exists($failed{$_})} @$obsolete) {
+ unlink ($param->{messagePath}."t$_.xml") or $failed{$_} = 'could not delete thread file';
+ file_removed ($param->{messagePath}."t$_.xml");
+ }
+ $cache -> delete_threads (@$obsolete);
+ $cache -> garbage_collection;
+ }
+ }
+ else {
+ violent_unlock_file ($param->{forumFile});
+ }
+ violent_unlock_file ($param->{lockFile}) unless (write_unlock_file ($param->{lockFile}));
+ }
+ else {
+ violent_unlock_file ($param->{lockFile});
+ }
+ }
+
+ # return
+ \%failed;
+}
+
+# keep require happy
+1;
+
+#
+#
+### end of Arc::Archive ########################################################
\ No newline at end of file
--- /dev/null
+package Arc::Test;
+
+################################################################################
+# #
+# File: shared/Arc/Test.pm #
+# #
+# Authors: Andre Malo <nd@o3media.de>, 2001-04-27 #
+# #
+# Description: check on obsolete threads #
+# #
+################################################################################
+
+use strict;
+
+################################################################################
+#
+# Export
+#
+use base qw(Exporter);
+@Arc::Test::EXPORT = qw(get_obsolete_threads);
+
+### sub get_obsolete_threads ($) ###############################################
+#
+# check forum main file on obsolete threads
+#
+# Params: $param - hash reference
+# (parsedThreads, adminDefault)
+#
+# Return: array reference containing the obsolete thread numbers
+# (may be empty)
+#
+sub get_obsolete_threads ($) {
+ my $param = shift;
+
+ my $thread_count = keys %{$param->{parsedThreads}};
+
+ my ($msg_count, $main_size, $tid, %tinfo) = (0, 0);
+ for $tid (keys %{$param->{parsedThreads}}) {
+ my $num = @{$param->{parsedThreads}->{$tid}};
+ $msg_count += $num;
+
+ my ($age, $size) = (0, 0);
+ for (@{$param->{parsedThreads}->{$tid}}) {
+ $age = ($age > $_->{time}) ? $age : $_->{time};
+ $size +=
+ length ($_->{name})
+ + length ($_->{cat})
+ + length ($_->{subject});
+ }
+ $size += $num * 190 + 30; # we guess a little bit ;-)
+ $main_size += $size;
+
+ $tinfo{$tid} = {
+ num => $num,
+ age => $age,
+ size => $size
+ };
+ }
+ $main_size += 140;
+
+ my $sev_opt;
+ if ($param -> {adminDefault} -> {Severance} -> {severance} eq 'instant') {
+ $sev_opt = $param -> {adminDefault} -> {Instant} -> {Severance};
+ }
+ else {
+ $sev_opt = $param -> {adminDefault} -> {Severance};
+ };
+
+ my @sorted;
+ if ($sev_opt->{severance} eq 'asymmetrical') {
+ @sorted = sort {$tinfo{$a}->{age} <=> $tinfo{$b}->{age}} keys %tinfo;
+ }
+ else {
+ @sorted = sort {$a <=> $b} keys %tinfo;
+ }
+
+ my $obsolete = 0;
+
+ # max size
+ #
+ if ($sev_opt -> {afterByte}) {
+ while ($main_size > $sev_opt -> {afterByte}) {
+ $main_size -= $tinfo{$sorted[$obsolete]}->{size};
+ $msg_count -= $tinfo{$sorted[$obsolete]}->{num};
+ $thread_count--;
+ }
+ continue {
+ $obsolete++;
+ }
+ }
+
+ # max messages
+ #
+ if ($sev_opt -> {afterMessage}) {
+ while ($msg_count > $sev_opt -> {afterMessage}) {
+ $msg_count -= $tinfo{$sorted[$obsolete]}->{num};
+ $thread_count--;
+ }
+ continue {
+ $obsolete++;
+ }
+ }
+
+ # max threads
+ #
+ $obsolete += $thread_count - $sev_opt -> {afterThread}
+ if ($sev_opt -> {afterThread} and $thread_count > $sev_opt -> {afterThread});
+
+ # return
+ [sort {$a <=> $b} splice @sorted => 0, $obsolete];
+}
+
+# keep require happy
+1;
+
+#
+#
+### end of Arc::Test ###########################################################
\ No newline at end of file
git.p6c8.net / selfforum.git / commitdiff