--- /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 <hs@schlittermann.de>
+# 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: