exigrey.pl
changeset 5 33a7d0576411
child 9 417562509dbe
--- /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: