equal
deleted
inserted
replaced
31 use POSIX qw/strftime mktime/; |
31 use POSIX qw/strftime mktime/; |
32 |
32 |
33 do "@LIBDIR@/exigrey.pl" |
33 do "@LIBDIR@/exigrey.pl" |
34 or do "./exim-exigrey.pl" or die $!; |
34 or do "./exim-exigrey.pl" or die $!; |
35 |
35 |
|
36 my $VERSION = '$Id$'; |
|
37 |
36 my $opt_list; |
38 my $opt_list; |
37 my $opt_stats; |
39 my $opt_stats; |
38 my $opt_insert; |
40 my $opt_insert; |
39 my $opt_help; |
41 my $opt_help; |
40 my $opt_clean; |
42 my $opt_clean; |
64 |
66 |
65 if ($opt_list) { |
67 if ($opt_list) { |
66 my %h; |
68 my %h; |
67 connectDB(\%h, shift); |
69 connectDB(\%h, shift); |
68 iterate(%h, sub { |
70 iterate(%h, sub { |
69 my ($item, $v0, $v1, $dv) = @_; |
71 my ($item, $v0, $v1, $c) = @_; |
70 printf "%-16s:\t$v0 $v1 (%3ds %s %s)\n", |
72 printf "%-16s:\t$v0 $v1 (%3d %s %s)\n", |
71 $item, $dv, |
73 $item, $c, |
72 strftime("%F %T", localtime($v0)), |
74 strftime("%F %T", localtime($v0)), |
73 strftime("%F %T", localtime($v1)); |
75 strftime("%F %T", localtime($v1)); |
74 }); |
76 }); |
75 exit 0; |
77 exit 0; |
76 } |
78 } |
81 my $db = connectDB(\%h, $_); |
83 my $db = connectDB(\%h, $_); |
82 |
84 |
83 my ($seen, $returned, $oldest_c, $oldest_u); |
85 my ($seen, $returned, $oldest_c, $oldest_u); |
84 $oldest_c = $oldest_u = time(); |
86 $oldest_c = $oldest_u = time(); |
85 iterate(%h, sub { |
87 iterate(%h, sub { |
86 my ($item, $v0, $v1, $dv) = @_; |
88 my ($item, $v0, $v1, $c) = @_; |
87 ++$seen; |
89 ++$seen; |
88 ++$returned if $dv; |
90 ++$returned if $c; |
89 $oldest_c = $v0 if $v0 < $oldest_c; |
91 $oldest_c = $v0 if $v0 < $oldest_c; |
90 $oldest_u = $v1 if $v1 < $oldest_u; |
92 $oldest_u = $v1 if $v1 < $oldest_u; |
91 }); |
93 }); |
92 |
94 |
93 $_ = <<__; |
95 $_ = <<__; |
118 foreach (getDBs(@ARGV)) { |
120 foreach (getDBs(@ARGV)) { |
119 my %h; |
121 my %h; |
120 my $tmp = tmpfile(); |
122 my $tmp = tmpfile(); |
121 my $db = connectDB(\%h, $_); |
123 my $db = connectDB(\%h, $_); |
122 iterate(%h, sub { |
124 iterate(%h, sub { |
123 my ($item, $v0, $v1, $dv) = @_; |
125 my ($item, $v0, $v1, $c) = @_; |
124 my $rv = defined $opt_purge ? \$v0 : \$v1; |
126 my $rv = defined $opt_purge ? \$v0 : \$v1; |
125 print $tmp "$item\0" if $$rv <= $cut; |
127 print $tmp "$item\0" if $$rv <= $cut; |
126 }); |
128 }); |
127 |
129 |
128 seek($tmp, 0, 0) or die "Can't seek tmpfile"; |
130 seek($tmp, 0, 0) or die "Can't seek tmpfile"; |
152 sub getDBs(@) { |
154 sub getDBs(@) { |
153 grep { -f } map { m(^\.?/) ? glob($_) : glob(getDBDir() . "/$_") } @_ ? @_ : "*"; |
155 grep { -f } map { m(^\.?/) ? glob($_) : glob(getDBDir() . "/$_") } @_ ? @_ : "*"; |
154 } |
156 } |
155 |
157 |
156 # Helper to iterate over our hash and call the passed |
158 # Helper to iterate over our hash and call the passed |
157 # "callback" function (item, v0, v1, delta) |
159 # "callback" function (item, v0, v1, count) |
158 sub iterate(\%$) { |
160 sub iterate(\%$) { |
159 my ($hash, $sub) = @_; |
161 my ($hash, $sub) = @_; |
160 while (my ($k, $v) = each %$hash) { |
162 while (my ($k, $v) = each %$hash) { |
161 chop($k, $v); |
163 chop($k, $v); |
162 my ($v0, $v1) = split " ", $v; |
164 &$sub($k, (split(" ", $v), 0)[0..2]); # 0 for filling |
163 my $dv = $v1 - $v0; |
|
164 &$sub($k, $v0, $v1, $dv); |
|
165 } |
165 } |
166 } |
166 } |
167 |
167 |
168 |
168 |
169 # vim:ft=perl aw sts=4 sw=4: |
169 # vim:ft=perl aw sts=4 sw=4: |