--- a/exigrey.pl Wed Jan 03 12:06:41 2007 +0000
+++ b/exigrey.pl Wed Jan 03 16:23:19 2007 +0000
@@ -8,14 +8,17 @@
Usage: !ME! --insert item [delay [db]] # insert an item
!ME! --list [db] # list all items
- !ME! --stat [db ...] # print short statistic
- !ME! --clean [days [db ...]] # remove items not used since <days> days
- !ME! --purge [days [db ...]] # remove items older than <days> days
- !ME! --dbs [glob] # list dbm files in default directory
+ !ME! --stat [db* ...] # print short statistic
+ !ME! --clean [days [db* ...]] # remove items not used since <days> days
+ !ME! --purge [days [db* ...]] # remove items older than <days> days
+ !ME! --dbs [db* ...] # list data base(s)
- Defaults: delay: !$DEFAULT{delay}!
- db: !$DEFAULT{db}!
- days: !$DEFAULT{days}!
+ db -- single name of database
+ db* -- glob pattern of database
+
+ If the data base name doesn't doesn't start with "./" or "/"
+ it is considered to be realtiv to exim_spool_dir/grey/.
+
#
use strict;
@@ -30,9 +33,6 @@
do "@LIBDIR@/exigrey.pl"
or do "./exim-exigrey.pl" or die $!;
-my %DEFAULT = getDefault();
- $DEFAULT{days} = 7;
-
my $opt_list;
my $opt_stats;
my $opt_insert;
@@ -41,7 +41,7 @@
my $opt_purge;
my $opt_dbs;
-sub getDBs($);
+sub getDBs(@);
sub iterate(\%$);
MAIN: {
@@ -64,7 +64,7 @@
if ($opt_list) {
my %h;
- connectDB(\%h, shift || $DEFAULT{db});
+ connectDB(\%h, shift);
iterate(%h, sub {
my ($item, $v0, $v1, $dv) = @_;
printf "%-16s:\t$v0 $v1 (%3ds %s %s)\n",
@@ -76,9 +76,7 @@
}
if ($opt_stats) {
- @ARGV = ($DEFAULT{db}) unless @ARGV;
- @ARGV = getDBs($ARGV[0]) if $ARGV[0] =~ /[\*\?]/;
- foreach (@ARGV) {
+ foreach (@ARGV = getDBs(@ARGV)) {
my %h;
my $db = connectDB(\%h, $_);
@@ -117,11 +115,7 @@
if ($opt_clean or $opt_purge) {
my $cut = time() - (86400 * (@ARGV ? shift : 7));
-
- @ARGV = ($DEFAULT{db}) unless @ARGV;
- @ARGV = getDBs($ARGV[0]) if $ARGV[0] =~ /[\*\?]/;
-
- foreach (@ARGV ? @ARGV : $DEFAULT{db}) {
+ foreach (getDBs(@ARGV)) {
my %h;
my $tmp = tmpfile();
my $db = connectDB(\%h, $_);
@@ -145,7 +139,7 @@
}
if ($opt_dbs) {
- print join("\n", getDBs(shift || "*")), "\n";
+ print join("\n", getDBs(@ARGV)), "\n";
exit 0;
}
@@ -155,8 +149,8 @@
}
}
-sub getDBs($) {
- glob(getDBDir() . "/$_[0]");
+sub getDBs(@) {
+ grep { -f } map { m(^\.?/) ? glob($_) : glob(getDBDir() . "/$_") } @_ ? @_ : "*";
}
# Helper to iterate over our hash and call the passed
--- a/exim-exigrey.pl Wed Jan 03 12:06:41 2007 +0000
+++ b/exim-exigrey.pl Wed Jan 03 16:23:19 2007 +0000
@@ -35,6 +35,9 @@
# record structure: key: item\0
# value: timestamp(creation) timestamp(usage)\0
# (This way we're compatible with ${lookup{...}dbm{...}})
+#
+# dbm file is relativ to $spool_directory/grey, EXCEPT its name
+# starts with "./" or "/".
sub unseen($;$$) {
my ($item, $delay, $db) = @_;
$item .= "\0";
@@ -45,7 +48,7 @@
my $rc;
my %h;
- $db = connectDB(\%h, $db || $DEFAULT{db});
+ $db = connectDB(\%h, $db);
if (not exists $h{$item}) {
$h{$item} = "$now $now\0";
@@ -97,7 +100,7 @@
sub connectDB($$) {
my ($h, $db) = @_;
- $db = getDBDir() ."/$db" unless $db =~ /^\//;
+ $db = getDBDir() ."/$db" unless $db =~ m(^\.?/);
# Creation of DB-File if it doesn't exist
# to avoid races we change our own uid/gid for creation of