added Arc::Archive and Arc::Test

diff --git a/selfforum-cgi/shared/Arc/Archive.pm b/selfforum-cgi/shared/Arc/Archive.pm
new file mode 100644 (file)
index 0000000..8b4daea
--- /dev/null
+++ b/selfforum-cgi/shared/Arc/Archive.pm
@@ -0,0 +1,228 @@
+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

diff --git a/selfforum-cgi/shared/Arc/Test.pm b/selfforum-cgi/shared/Arc/Test.pm
new file mode 100644 (file)
index 0000000..6851912
--- /dev/null
+++ b/selfforum-cgi/shared/Arc/Test.pm
@@ -0,0 +1,118 @@
+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