wildcard behaviour cleaned
authorheiko
Wed, 03 Jan 2007 16:23:19 +0000
changeset 31 7d2c9f3186f4
parent 30 0ad61ee59889
child 32 139808a46c7b
wildcard behaviour cleaned
exigrey.pl
exim-exigrey.pl
--- 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