8 |
8 |
9 Usage: !ME! --insert item [delay [db]] # insert an item |
9 Usage: !ME! --insert item [delay [db]] # insert an item |
10 !ME! --list [db] # list all items |
10 !ME! --list [db] # list all items |
11 !ME! --stat [db ...] # print short statistic |
11 !ME! --stat [db ...] # print short statistic |
12 !ME! --clean [days [db ...]] # remove items not used since <days> days |
12 !ME! --clean [days [db ...]] # remove items not used since <days> days |
|
13 !ME! --purge [days [db ...]] # remove items older than <days> days |
13 !ME! --dbs [glob] # list dbm files in default directory |
14 !ME! --dbs [glob] # list dbm files in default directory |
14 |
15 |
15 Defaults: delay: !$DEFAULT{delay}! |
16 Defaults: delay: !$DEFAULT{delay}! |
16 db: !$DEFAULT{db}! |
17 db: !$DEFAULT{db}! |
17 days: !$DEFAULT{days}! |
18 days: !$DEFAULT{days}! |
47 GetOptions( |
49 GetOptions( |
48 "list!" => \$opt_list, |
50 "list!" => \$opt_list, |
49 "insert!" => \$opt_insert, |
51 "insert!" => \$opt_insert, |
50 "stats!" => \$opt_stats, |
52 "stats!" => \$opt_stats, |
51 "clean!" => \$opt_clean, |
53 "clean!" => \$opt_clean, |
|
54 "purge!" => \$opt_purge, |
52 "dbs!" => \$opt_dbs, |
55 "dbs!" => \$opt_dbs, |
53 "help!" => \$opt_help, |
56 "help!" => \$opt_help, |
54 ) or die ME.": Bad usage, try ".ME." --help.\n"; |
57 ) or die ME.": Bad usage, try ".ME." --help.\n"; |
55 |
58 |
56 if ($opt_help) { |
59 if ($opt_help) { |
77 @ARGV = getDBs($ARGV[0]) if $ARGV[0] =~ /[\*\?]/; |
80 @ARGV = getDBs($ARGV[0]) if $ARGV[0] =~ /[\*\?]/; |
78 foreach (@ARGV) { |
81 foreach (@ARGV) { |
79 my %h; |
82 my %h; |
80 my $db = connectDB(\%h, $_); |
83 my $db = connectDB(\%h, $_); |
81 |
84 |
82 my ($seen, $returned, $oldest); |
85 my ($seen, $returned, $oldest_c, $oldest_u); |
83 $oldest = time(); |
86 $oldest_c = $oldest_u = time(); |
84 iterate(%h, sub { |
87 iterate(%h, sub { |
85 my ($item, $v0, $v1, $dv) = @_; |
88 my ($item, $v0, $v1, $dv) = @_; |
86 ++$seen; |
89 ++$seen; |
87 ++$returned if $dv; |
90 ++$returned if $dv; |
88 $oldest = $v0 if $v0 < $oldest; |
91 $oldest_c = $v0 if $v0 < $oldest_c; |
|
92 $oldest_u = $v1 if $v1 < $oldest_u; |
89 }); |
93 }); |
90 |
94 |
91 $_ = <<__; |
95 $_ = <<__; |
92 date: %s |
96 date: %s |
93 db: $db (ls: %.1f MB / du: %.1f MB) |
97 db: $db (ls: %.1f MB / du: %.1f MB) |
94 total: $seen |
98 total: $seen |
95 not returned: %d (%d%%) |
99 not returned: %d (%d%%) |
96 oldest: %.1f days (%s) |
100 oldest (created): %.1f days (%s) |
|
101 oldest (used): %.1f days (%s) |
97 __ |
102 __ |
98 printf $_, |
103 printf $_, |
99 scalar(localtime), |
104 scalar(localtime), |
100 (-s $db) / (1024*1024), |
105 (-s $db) / (1024*1024), |
101 ((stat $db)[12]*512)/(1024*1024), |
106 ((stat $db)[12]*512)/(1024*1024), |
102 $seen - $returned, |
107 $seen - $returned, |
103 int(100 * ($seen-$returned)/$seen), |
108 int(100 * ($seen-$returned)/$seen), |
104 ((time - $oldest) / 86400), scalar(localtime $oldest); |
109 ((time - $oldest_c) / 86400), scalar(localtime $oldest_c), |
|
110 ((time - $oldest_u) / 86400), scalar(localtime $oldest_u); |
105 print "\n" if @ARGV; |
111 print "\n" if @ARGV; |
106 |
112 |
107 } |
113 } |
108 exit 0; |
114 exit 0; |
109 } |
115 } |
110 |
116 |
111 if ($opt_clean) { |
117 if ($opt_clean or $opt_purge) { |
|
118 |
112 my $cut = time() - (86400 * (@ARGV ? shift : 7)); |
119 my $cut = time() - (86400 * (@ARGV ? shift : 7)); |
|
120 |
113 @ARGV = ($DEFAULT{db}) unless @ARGV; |
121 @ARGV = ($DEFAULT{db}) unless @ARGV; |
114 @ARGV = getDBs($ARGV[0]) if $ARGV[0] =~ /[\*\?]/; |
122 @ARGV = getDBs($ARGV[0]) if $ARGV[0] =~ /[\*\?]/; |
|
123 |
115 foreach (@ARGV ? @ARGV : $DEFAULT{db}) { |
124 foreach (@ARGV ? @ARGV : $DEFAULT{db}) { |
116 my %h; |
125 my %h; |
117 my $tmp = tmpfile(); |
126 my $tmp = tmpfile(); |
118 my $db = connectDB(\%h, $_); |
127 my $db = connectDB(\%h, $_); |
119 iterate(%h, sub { |
128 iterate(%h, sub { |
120 my ($item, $v0, $v1, $dv) = @_; |
129 my ($item, $v0, $v1, $dv) = @_; |
121 print $tmp $item if $v1 <= $cut; |
130 my $rv = defined $opt_purge ? \$v0 : \$v1; |
|
131 print $tmp "$item\0" if $$rv <= $cut; |
122 }); |
132 }); |
123 |
133 |
124 seek($tmp, 0, 0) or die "Can't seek tmpfile"; |
134 seek($tmp, 0, 0) or die "Can't seek tmpfile"; |
|
135 |
|
136 $/ = "\0"; |
125 delete $h{$_} while <$tmp>; |
137 delete $h{$_} while <$tmp>; |
|
138 print "$. items deleted from $db\n"; |
|
139 |
126 close($tmp); |
140 close($tmp); |
127 |
141 |
128 print "$. items deleted from $db\n"; |
|
129 } |
142 } |
130 exit 0; |
143 exit 0; |
131 } |
144 } |
132 |
145 |
133 if ($opt_dbs) { |
146 if ($opt_dbs) { |