--- a/exigrey.pl Wed Jun 13 06:57:49 2007 +0000
+++ b/exigrey.pl Fri Jan 18 21:59:55 2008 +0000
@@ -30,8 +30,9 @@
use FindBin qw/$Bin/;
use POSIX qw/strftime mktime/;
-do "@LIBDIR@/exim-exigrey.pl"
- or do "./exim-exigrey.pl" or die $!;
+do "@LIBDIR@/exim-exigrey.pl"
+ or do "./exim-exigrey.pl"
+ or die $!;
my $VERSION = '$Id$';
@@ -49,53 +50,60 @@
MAIN: {
GetOptions(
- "list!" => \$opt_list,
- "insert!" => \$opt_insert,
- "stats!" => \$opt_stats,
- "clean!" => \$opt_clean,
- "purge!" => \$opt_purge,
- "dbs!" => \$opt_dbs,
- "help!" => \$opt_help,
- ) or die ME.": Bad usage, try ".ME." --help.\n";
+ "list!" => \$opt_list,
+ "insert!" => \$opt_insert,
+ "stats!" => \$opt_stats,
+ "clean!" => \$opt_clean,
+ "purge!" => \$opt_purge,
+ "dbs!" => \$opt_dbs,
+ "help!" => \$opt_help,
+ ) or die ME . ": Bad usage, try " . ME . " --help.\n";
if ($opt_help) {
- ($_ = USAGE) =~ s/!(.*?)!/eval $1/eg;
- print; exit 0;
- };
+ ($_ = USAGE) =~ s/!(.*?)!/eval $1/eg;
+ print;
+ exit 0;
+ }
if ($opt_list) {
- foreach (@ARGV = getDBs(@ARGV)) {
- my %h;
- my $db = connectDB(\%h, $_);
- print "# $db\n";
- iterate(%h, sub {
- my ($item, $v0, $v1, $c) = @_;
- printf "$item: $v0 $v1 $c (%s %s)\n",
- strftime("%FT%T", localtime($v0)),
- strftime("%FT%T", localtime($v1));
- });
- print "\n" if @ARGV;
- }
- exit 0;
+ foreach (@ARGV = getDBs(@ARGV)) {
+ my %h;
+ my $db = connectDB(\%h, $_);
+ print "# $db\n";
+ iterate(
+ %h,
+ sub {
+ my ($item, $v0, $v1, $c) = @_;
+ printf "$item: $v0 $v1 $c (%s %s)\n",
+ strftime("%FT%T", localtime($v0)),
+ strftime("%FT%T", localtime($v1));
+ }
+ );
+ print "\n" if @ARGV;
+ }
+ exit 0;
}
if ($opt_stats) {
- foreach (@ARGV = getDBs(@ARGV)) {
- my %h;
- my $db = connectDB(\%h, $_);
+ foreach (@ARGV = getDBs(@ARGV)) {
+ my %h;
+ my $db = connectDB(\%h, $_);
- my ($seen, $returned, $oldest_c, $oldest_u);
- $seen = $returned = 0;
- $oldest_c = $oldest_u = time();
- iterate(%h, sub {
- my ($item, $v0, $v1, $c) = @_;
- ++$seen;
- ++$returned if $v0 != $v1; # soon it can be $c
- $oldest_c = $v0 if $v0 < $oldest_c;
- $oldest_u = $v1 if $v1 < $oldest_u;
- });
+ my ($seen, $returned, $oldest_c, $oldest_u);
+ $seen = $returned = 0;
+ $oldest_c = $oldest_u = time();
+ iterate(
+ %h,
+ sub {
+ my ($item, $v0, $v1, $c) = @_;
+ ++$seen;
+ ++$returned if $v0 != $v1; # soon it can be $c
+ $oldest_c = $v0 if $v0 < $oldest_c;
+ $oldest_u = $v1 if $v1 < $oldest_u;
+ }
+ );
- $_ = <<__;
+ $_ = <<__;
date: %s
db: $db (ls: %.1f MB / du: %.1f MB)
total: $seen (100%%)
@@ -104,59 +112,60 @@
oldest (created): %.1f days (%s)
oldest (used): %.1f days (%s)
__
- printf $_,
- scalar(localtime),
- (-s $db) / (1024*1024),
- ((stat $db)[12]*512)/(1024*1024),
- length($seen), $returned, int(0.5 + 100 * ($returned/$seen)),
- length($seen), $seen - $returned, int(0.5 + 100 * ($seen-$returned)/$seen),
- ((time - $oldest_c) / 86400), scalar(localtime $oldest_c),
- ((time - $oldest_u) / 86400), scalar(localtime $oldest_u);
- print "\n" if @ARGV;
+ printf $_, scalar(localtime), (-s $db) / (1024 * 1024),
+ ((stat $db)[12] * 512) / (1024 * 1024), length($seen), $returned,
+ int(0.5 + 100 * ($returned / $seen)), length($seen),
+ $seen - $returned, int(0.5 + 100 * ($seen - $returned) / $seen),
+ ((time - $oldest_c) / 86400), scalar(localtime $oldest_c),
+ ((time - $oldest_u) / 86400), scalar(localtime $oldest_u);
+ print "\n" if @ARGV;
- }
- exit 0;
+ }
+ exit 0;
}
if ($opt_clean or $opt_purge) {
- my $cut = time() - (86400 * (@ARGV ? shift : 7));
- foreach (getDBs(@ARGV)) {
- my %h;
- my $tmp = tmpfile();
- my $db = connectDB(\%h, $_);
- iterate(%h, sub {
- my ($item, $v0, $v1, $c) = @_;
- my $rv = defined $opt_purge ? \$v0 : \$v1;
- print $tmp "$item\0" if $$rv <= $cut;
- });
+ my $cut = time() - (86400 * (@ARGV ? shift: 7));
+ foreach (getDBs(@ARGV)) {
+ my %h;
+ my $tmp = tmpfile();
+ my $db = connectDB(\%h, $_);
+ iterate(
+ %h,
+ sub {
+ my ($item, $v0, $v1, $c) = @_;
+ my $rv = defined $opt_purge ? \$v0 : \$v1;
+ print $tmp "$item\0" if $$rv <= $cut;
+ }
+ );
- seek($tmp, 0, 0) or die "Can't seek tmpfile";
+ seek($tmp, 0, 0) or die "Can't seek tmpfile";
- $/ = "\0";
- delete $h{$_} while <$tmp>;
- printf "$. items %s from $db\n",
- $opt_purge ? "purged" : "deleted";
+ $/ = "\0";
+ delete $h{$_} while <$tmp>;
+ printf "$. items %s from $db\n", $opt_purge ? "purged" : "deleted";
- close($tmp);
+ close($tmp);
- }
- exit 0;
+ }
+ exit 0;
}
if ($opt_dbs) {
- print join("\n", getDBs(@ARGV)), "\n";
- exit 0;
+ print join("\n", getDBs(@ARGV)), "\n";
+ exit 0;
}
if ($opt_insert) {
- print unseen(@ARGV);
- exit 0;
+ print unseen(@ARGV);
+ exit 0;
}
}
sub getDBs(@) {
- grep { -f } map { m(^\.?/) ? glob($_) : glob(getDBDir() . "/$_") } @_ ? @_ : "*";
+ grep { -f }
+ map { m(^\.?/) ? glob($_) : glob(getDBDir() . "/$_") } @_ ? @_ : "*";
}
# Helper to iterate over our hash and call the passed
@@ -164,10 +173,9 @@
sub iterate(\%$) {
my ($hash, $sub) = @_;
while (my ($k, $v) = each %$hash) {
- chop($k, $v);
- &$sub($k, (split(" ", $v), 0)[0..2]); # 0 for filling
+ chop($k, $v);
+ &$sub($k, (split(" ", $v), 0)[ 0 .. 2 ]); # 0 for filling
}
}
-
# vim:ft=perl aw sts=4 sw=4: