selfforum-cgi/shared/Arc/Test.pm

   1 package Arc::Test;
   2
   3 ################################################################################
   4 #                                                                              #
   5 # File:        shared/Arc/Test.pm                                              #
   6 #                                                                              #
   7 # Authors:     André Malo <nd@o3media.de>                                      #
   8 #                                                                              #
   9 # Description: check on obsolete threads                                       #
  10 #                                                                              #
  11 ################################################################################
  12
  13 use strict;
  14 use vars qw(
  15   @EXPORT
  16   $VERSION
  17 );
  18
  19 ################################################################################
  20 #
  21 # Version check
  22 #
  23 # last modified:
  24 #    $Date$ (GMT)
  25 # by $Author$
  26 #
  27 sub VERSION {(q$Revision$ =~ /([\d.]+)\s*$/)[0] or '0.0'}
  28
  29 ################################################################################
  30 #
  31 # Export
  32 #
  33 use base qw(Exporter);
  34 @EXPORT = qw(get_obsolete_threads);
  35
  36 ### sub get_obsolete_threads ($) ###############################################
  37 #
  38 # check forum main file on obsolete threads
  39 #
  40 # Params: $param - hash reference
  41 #                  (parsedThreads, adminDefault)
  42 #
  43 # Return: array reference containing the obsolete thread numbers
  44 #         (may be empty)
  45 #
  46 sub get_obsolete_threads ($) {
  47   my $param = shift;
  48
  49   my $thread_count = keys %{$param->{parsedThreads}};
  50
  51   my ($msg_count, $main_size, $tid, %tinfo) = (0, 0);
  52   for $tid (keys %{$param->{parsedThreads}}) {
  53     my $num = @{$param->{parsedThreads}->{$tid}};
  54     $msg_count += $num;
  55
  56     my ($age, $size) = (0, 0);
  57     for (@{$param->{parsedThreads}->{$tid}}) {
  58       $age   = ($age > $_->{time}) ? $age : $_->{time};
  59       $size +=
  60         length ($_->{name})
  61       + length ($_->{cat})
  62       + length ($_->{subject});
  63     }
  64     $size      += $num * 190 + 30;  # we guess a little bit ;-)
  65     $main_size += $size;
  66
  67     $tinfo{$tid} = {
  68       num  => $num,
  69       age  => $age,
  70       size => $size
  71     };
  72   }
  73   $main_size += 140;
  74
  75   my $sev_opt;
  76   if ($param -> {adminDefault} -> {Severance} -> {severance} eq 'instant') {
  77     $sev_opt = $param -> {adminDefault} -> {Instant} -> {Severance};
  78   }
  79   else {
  80     $sev_opt = $param -> {adminDefault} -> {Severance};
  81   };
  82
  83   my @sorted;
  84   if ($sev_opt->{severance} eq 'asymmetrical') {
  85     @sorted = sort {$tinfo{$a}->{age} <=> $tinfo{$b}->{age}} keys %tinfo;
  86   }
  87   else {
  88     @sorted = sort {$a <=> $b} keys %tinfo;
  89   }
  90
  91   my $obsolete = 0;
  92
  93   # max size
  94   #
  95   if ($sev_opt -> {afterByte}) {
  96     while ($main_size > $sev_opt -> {afterByte}) {
  97       $main_size -= $tinfo{$sorted[$obsolete]}->{size};
  98       $msg_count -= $tinfo{$sorted[$obsolete]}->{num};
  99       $thread_count--;
 100     }
 101     continue {
 102       $obsolete++;
 103     }
 104   }
 105
 106   # max messages
 107   #
 108   if ($sev_opt -> {afterMessage}) {
 109     while ($msg_count > $sev_opt -> {afterMessage}) {
 110       $msg_count -= $tinfo{$sorted[$obsolete]}->{num};
 111       $thread_count--;
 112     }
 113     continue {
 114       $obsolete++;
 115     }
 116   }
 117
 118   # max threads
 119   #
 120   $obsolete += $thread_count - $sev_opt -> {afterThread}
 121     if ($sev_opt -> {afterThread} and $thread_count > $sev_opt -> {afterThread});
 122
 123   # return
 124   [sort {$a <=> $b} splice @sorted => 0, $obsolete];
 125 }
 126
 127 # keep 'require' happy
 128 1;
 129
 130 #
 131 #
 132 ### end of Arc::Test ###########################################################