1 #! /usr/bin/perl

     2 # © 2006,2007 Heiko Schlittermann <hs@schlittermann.de>

     3 # Quick and dirty. Absolutly no warranty. Not even for spelling ;-)

     4 # $Id$

     5 # $URL$

     6 

     7 use constant USAGE => <<'#';

     8 

     9 Usage: !ME! item [delay [db]]

    10        !ME! --list [db]

    11        !ME! --stat [db]

    12        !ME! --clean [days [db]]

    13 

    14        Defaults: delay: !$DEFAULT{delay}!

    15 		 db:    !$DEFAULT{db}!

    16 		 days:	!$DEFAULT{days}!

    17 #

    18 

    19 use strict;

    20 use warnings;

    21 use Getopt::Long;

    22 use File::Basename;

    23 use constant ME => basename $0;

    24 use FindBin qw/$Bin/;

    25 use POSIX qw/strftime mktime/;

    26 

    27 do "$Bin/greylist.pl" or die;

    28 my %DEFAULT = getDefault();

    29    $DEFAULT{days} = 7;

    30 

    31 my $opt_list;

    32 my $opt_stats;

    33 my $opt_help;

    34 

    35 sub iterate(\%$);

    36 

    37 MAIN: {

    38 

    39     GetOptions(

    40 	"list!" => \$opt_list,

    41 	"stats!" => \$opt_stats,

    42 	"help!" => \$opt_help

    43     ) or die ME.": Bad usage, try ".ME." --help.\n";

    44 

    45     if ($opt_help) {

    46 	($_ = USAGE) =~ s/!(.*?)!/eval $1/eg;

    47 	print; exit 0;

    48     };

    49 

    50     my $db = shift || $DEFAULT{db};

    51     $db = getDBDir() ."/$db" unless $db =~ /^\//;

    52 

    53     my %h; tie %h, "BerkeleyDB::Hash", -Filename => $db or die;

    54 

    55     if ($opt_list) {

    56 	iterate(%h, sub {

    57 	    my ($item, $v0, $v1, $dv) = @_;

    58 	    printf "%-16s:\t$v0 $v1 (%3ds %s %s)\n", 

    59 		    $item, $dv, 

    60 		    strftime("%F %T", localtime($v0)), 

    61 		    strftime("%F %T", localtime($v1));

    62 	});

    63 	exit 0;

    64     }

    65 

    66     if ($opt_stats) {

    67 	my ($seen, $returned, $oldest);

    68 	$oldest = time();

    69 	iterate(%h, sub {

    70 	    my ($item, $v0, $v1, $dv) = @_;

    71 	    ++$seen;

    72 	    ++$returned if $dv;

    73 	    $oldest = $v0 if $v0 < $oldest;

    74 	});

    75 

    76 	$_ = <<__;

    77         date: %s

    78           db: $db

    79        total: $seen

    80 not returned: %d (%d%%)

    81       oldest: %.1f days (%s)

    82 __

    83 	printf $_, 

    84 		scalar(localtime), 

    85 		$seen - $returned, 

    86 		int(100 * ($seen-$returned)/$seen), 

    87 		((time - $oldest) / 86400), scalar(localtime $oldest);

    88 

    89 	exit 0;

    90     }

    91 

    92     print unseen(@ARGV, 10) . "\n";

    93 }

    94 

    95 # Helper to iterate over our hash and call the passed

    96 # "callback" function (item, v0, v1, delta)

    97 sub iterate(\%$) {

    98     my ($hash, $sub) = @_;

    99     while (my ($k, $v) = each %$hash) {

   100 	chop($k, $v);

   101 	my ($v0, $v1) = split " ", $v;

   102 	my $dv = $v1 - $v0;

   103 	&$sub($k, $v0, $v1, $dv);

   104     }

   105 }

   106 

   107 # vim:ft=perl aw sts=4 sw=4: