diff -r 676e54f00c44 -r 33a7d0576411 exigrey.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/exigrey.pl Mon Jan 01 19:34:50 2007 +0000 @@ -0,0 +1,107 @@ +#! /usr/bin/perl +# © 2006,2007 Heiko Schlittermann +# Quick and dirty. Absolutly no warranty. Not even for spelling ;-) +# $Id$ +# $URL$ + +use constant USAGE => <<'#'; + +Usage: !ME! item [delay [db]] + !ME! --list [db] + !ME! --stat [db] + !ME! --clean [days [db]] + + Defaults: delay: !$DEFAULT{delay}! + db: !$DEFAULT{db}! + days: !$DEFAULT{days}! +# + +use strict; +use warnings; +use Getopt::Long; +use File::Basename; +use constant ME => basename $0; +use FindBin qw/$Bin/; +use POSIX qw/strftime mktime/; + +do "$Bin/greylist.pl" or die; +my %DEFAULT = getDefault(); + $DEFAULT{days} = 7; + +my $opt_list; +my $opt_stats; +my $opt_help; + +sub iterate(\%$); + +MAIN: { + + GetOptions( + "list!" => \$opt_list, + "stats!" => \$opt_stats, + "help!" => \$opt_help + ) or die ME.": Bad usage, try ".ME." --help.\n"; + + if ($opt_help) { + ($_ = USAGE) =~ s/!(.*?)!/eval $1/eg; + print; exit 0; + }; + + my $db = shift || $DEFAULT{db}; + $db = getDBDir() ."/$db" unless $db =~ /^\//; + + my %h; tie %h, "BerkeleyDB::Hash", -Filename => $db or die; + + if ($opt_list) { + iterate(%h, sub { + my ($item, $v0, $v1, $dv) = @_; + printf "%-16s:\t$v0 $v1 (%3ds %s %s)\n", + $item, $dv, + strftime("%F %T", localtime($v0)), + strftime("%F %T", localtime($v1)); + }); + exit 0; + } + + if ($opt_stats) { + my ($seen, $returned, $oldest); + $oldest = time(); + iterate(%h, sub { + my ($item, $v0, $v1, $dv) = @_; + ++$seen; + ++$returned if $dv; + $oldest = $v0 if $v0 < $oldest; + }); + + $_ = <<__; + date: %s + db: $db + total: $seen +not returned: %d (%d%%) + oldest: %.1f days (%s) +__ + printf $_, + scalar(localtime), + $seen - $returned, + int(100 * ($seen-$returned)/$seen), + ((time - $oldest) / 86400), scalar(localtime $oldest); + + exit 0; + } + + print unseen(@ARGV, 10) . "\n"; +} + +# Helper to iterate over our hash and call the passed +# "callback" function (item, v0, v1, delta) +sub iterate(\%$) { + my ($hash, $sub) = @_; + while (my ($k, $v) = each %$hash) { + chop($k, $v); + my ($v0, $v1) = split " ", $v; + my $dv = $v1 - $v0; + &$sub($k, $v0, $v1, $dv); + } +} + +# vim:ft=perl aw sts=4 sw=4: