selfforum-cgi/shared/Arc/Test.pm

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