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

patrick-canterino.de