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