cleanup implemented
authorheiko
Mon, 01 Jan 2007 16:16:36 +0000
changeset 4 676e54f00c44
parent 3 8bf654c271d2
child 5 33a7d0576411
cleanup implemented
exigrey
--- a/exigrey	Sun Dec 31 21:40:26 2006 +0000
+++ b/exigrey	Mon Jan 01 16:16:36 2007 +0000
@@ -20,6 +20,7 @@
 use warnings;
 use Getopt::Long;
 use File::Basename;
+use File::Temp qw/tmpfile/;
 use constant ME => basename $0;
 use FindBin qw/$Bin/;
 use POSIX qw/strftime mktime/;
@@ -30,15 +31,19 @@
 
 my $opt_list;
 my $opt_stats;
+my $opt_clean;
 my $opt_help;
 
 sub iterate(\%$);
+sub connectDB(\%$);
+
 
 MAIN: {
 
     GetOptions(
 	"list!" => \$opt_list,
 	"stats!" => \$opt_stats,
+	"clean!" => \$opt_clean,
 	"help!" => \$opt_help
     ) or die ME.": Bad usage, try ".ME." --help.\n";
 
@@ -47,16 +52,14 @@
 	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) {
+	my %h;
+	connectDB(%h, shift || $DEFAULT{db});
 	iterate(%h, sub {
 	    my ($item, $v0, $v1, $dv) = @_;
-	    printf "%-16s:\t$v0 $v1 (%3ds %s %s)\n", 
-		    $item, $dv, 
+	    printf "%-16s:\t$v0 $v1 (%.1f %s %s)\n", 
+		    $item, $dv/86400, 
 		    strftime("%F %T", localtime($v0)), 
 		    strftime("%F %T", localtime($v1));
 	});
@@ -64,6 +67,9 @@
     }
 
     if ($opt_stats) {
+	my %h; 
+	my $db = connectDB(%h, shift || $DEFAULT{db});
+
 	my ($seen, $returned, $oldest);
 	$oldest = time();
 	iterate(%h, sub {
@@ -90,9 +96,42 @@
 	exit 0;
     }
 
+    if ($opt_clean) {
+	my %h;
+	my ($days, $db) = @ARGV;
+	    $days = 7 unless defined $days;
+	$db = connectDB(%h, $db || $DEFAULT{db});
+
+	my $cut = time() - ($days * 86400);
+	my $tmp = tmpfile();
+	iterate(%h, sub {
+	    my ($item, $v0, $v1, $dv) = @_;
+
+	    # We can't delete the items directly!
+	    print $tmp "$item\0" if $v1 <= $cut;
+	});
+
+	seek($tmp, 0, 0) or die;
+	$/ = "\0";
+	delete $h{$_} while <$tmp>;
+	print "$. records deleted\n";
+
+	exit 0;
+    }
+
+
+
     print unseen(@ARGV, 10) . "\n";
 }
 
+
+sub connectDB(\%$) {
+    my ($h, $db) = @_;
+    $db = getDBDir() ."/$db" unless $db =~ /^\//;
+    tie %$h, "BerkeleyDB::Hash", -Filename => $db or die;
+    return $db;
+}
+
 # Helper to iterate over our hash and call the passed
 # "callback" function (item, v0, v1, delta)
 sub iterate(\%$) {