47 sub iterate(\%$); |
48 sub iterate(\%$); |
48 |
49 |
49 MAIN: { |
50 MAIN: { |
50 |
51 |
51 GetOptions( |
52 GetOptions( |
52 "list!" => \$opt_list, |
53 "list!" => \$opt_list, |
53 "insert!" => \$opt_insert, |
54 "insert!" => \$opt_insert, |
54 "stats!" => \$opt_stats, |
55 "stats!" => \$opt_stats, |
55 "clean!" => \$opt_clean, |
56 "clean!" => \$opt_clean, |
56 "purge!" => \$opt_purge, |
57 "purge!" => \$opt_purge, |
57 "dbs!" => \$opt_dbs, |
58 "dbs!" => \$opt_dbs, |
58 "help!" => \$opt_help, |
59 "help!" => \$opt_help, |
59 ) or die ME.": Bad usage, try ".ME." --help.\n"; |
60 ) or die ME . ": Bad usage, try " . ME . " --help.\n"; |
60 |
61 |
61 if ($opt_help) { |
62 if ($opt_help) { |
62 ($_ = USAGE) =~ s/!(.*?)!/eval $1/eg; |
63 ($_ = USAGE) =~ s/!(.*?)!/eval $1/eg; |
63 print; exit 0; |
64 print; |
64 }; |
65 exit 0; |
|
66 } |
65 |
67 |
66 if ($opt_list) { |
68 if ($opt_list) { |
67 foreach (@ARGV = getDBs(@ARGV)) { |
69 foreach (@ARGV = getDBs(@ARGV)) { |
68 my %h; |
70 my %h; |
69 my $db = connectDB(\%h, $_); |
71 my $db = connectDB(\%h, $_); |
70 print "# $db\n"; |
72 print "# $db\n"; |
71 iterate(%h, sub { |
73 iterate( |
72 my ($item, $v0, $v1, $c) = @_; |
74 %h, |
73 printf "$item: $v0 $v1 $c (%s %s)\n", |
75 sub { |
74 strftime("%FT%T", localtime($v0)), |
76 my ($item, $v0, $v1, $c) = @_; |
75 strftime("%FT%T", localtime($v1)); |
77 printf "$item: $v0 $v1 $c (%s %s)\n", |
76 }); |
78 strftime("%FT%T", localtime($v0)), |
77 print "\n" if @ARGV; |
79 strftime("%FT%T", localtime($v1)); |
78 } |
80 } |
79 exit 0; |
81 ); |
|
82 print "\n" if @ARGV; |
|
83 } |
|
84 exit 0; |
80 } |
85 } |
81 |
86 |
82 if ($opt_stats) { |
87 if ($opt_stats) { |
83 foreach (@ARGV = getDBs(@ARGV)) { |
88 foreach (@ARGV = getDBs(@ARGV)) { |
84 my %h; |
89 my %h; |
85 my $db = connectDB(\%h, $_); |
90 my $db = connectDB(\%h, $_); |
86 |
91 |
87 my ($seen, $returned, $oldest_c, $oldest_u); |
92 my ($seen, $returned, $oldest_c, $oldest_u); |
88 $seen = $returned = 0; |
93 $seen = $returned = 0; |
89 $oldest_c = $oldest_u = time(); |
94 $oldest_c = $oldest_u = time(); |
90 iterate(%h, sub { |
95 iterate( |
91 my ($item, $v0, $v1, $c) = @_; |
96 %h, |
92 ++$seen; |
97 sub { |
93 ++$returned if $v0 != $v1; # soon it can be $c |
98 my ($item, $v0, $v1, $c) = @_; |
94 $oldest_c = $v0 if $v0 < $oldest_c; |
99 ++$seen; |
95 $oldest_u = $v1 if $v1 < $oldest_u; |
100 ++$returned if $v0 != $v1; # soon it can be $c |
96 }); |
101 $oldest_c = $v0 if $v0 < $oldest_c; |
|
102 $oldest_u = $v1 if $v1 < $oldest_u; |
|
103 } |
|
104 ); |
97 |
105 |
98 $_ = <<__; |
106 $_ = <<__; |
99 date: %s |
107 date: %s |
100 db: $db (ls: %.1f MB / du: %.1f MB) |
108 db: $db (ls: %.1f MB / du: %.1f MB) |
101 total: $seen (100%%) |
109 total: $seen (100%%) |
102 returned: %*d (%3d%%) |
110 returned: %*d (%3d%%) |
103 not returned: %*d (%3d%%) |
111 not returned: %*d (%3d%%) |
104 oldest (created): %.1f days (%s) |
112 oldest (created): %.1f days (%s) |
105 oldest (used): %.1f days (%s) |
113 oldest (used): %.1f days (%s) |
106 __ |
114 __ |
107 printf $_, |
115 printf $_, scalar(localtime), (-s $db) / (1024 * 1024), |
108 scalar(localtime), |
116 ((stat $db)[12] * 512) / (1024 * 1024), length($seen), $returned, |
109 (-s $db) / (1024*1024), |
117 int(0.5 + 100 * ($returned / $seen)), length($seen), |
110 ((stat $db)[12]*512)/(1024*1024), |
118 $seen - $returned, int(0.5 + 100 * ($seen - $returned) / $seen), |
111 length($seen), $returned, int(0.5 + 100 * ($returned/$seen)), |
119 ((time - $oldest_c) / 86400), scalar(localtime $oldest_c), |
112 length($seen), $seen - $returned, int(0.5 + 100 * ($seen-$returned)/$seen), |
120 ((time - $oldest_u) / 86400), scalar(localtime $oldest_u); |
113 ((time - $oldest_c) / 86400), scalar(localtime $oldest_c), |
121 print "\n" if @ARGV; |
114 ((time - $oldest_u) / 86400), scalar(localtime $oldest_u); |
|
115 print "\n" if @ARGV; |
|
116 |
122 |
117 } |
123 } |
118 exit 0; |
124 exit 0; |
119 } |
125 } |
120 |
126 |
121 if ($opt_clean or $opt_purge) { |
127 if ($opt_clean or $opt_purge) { |
122 |
128 |
123 my $cut = time() - (86400 * (@ARGV ? shift : 7)); |
129 my $cut = time() - (86400 * (@ARGV ? shift: 7)); |
124 foreach (getDBs(@ARGV)) { |
130 foreach (getDBs(@ARGV)) { |
125 my %h; |
131 my %h; |
126 my $tmp = tmpfile(); |
132 my $tmp = tmpfile(); |
127 my $db = connectDB(\%h, $_); |
133 my $db = connectDB(\%h, $_); |
128 iterate(%h, sub { |
134 iterate( |
129 my ($item, $v0, $v1, $c) = @_; |
135 %h, |
130 my $rv = defined $opt_purge ? \$v0 : \$v1; |
136 sub { |
131 print $tmp "$item\0" if $$rv <= $cut; |
137 my ($item, $v0, $v1, $c) = @_; |
132 }); |
138 my $rv = defined $opt_purge ? \$v0 : \$v1; |
|
139 print $tmp "$item\0" if $$rv <= $cut; |
|
140 } |
|
141 ); |
133 |
142 |
134 seek($tmp, 0, 0) or die "Can't seek tmpfile"; |
143 seek($tmp, 0, 0) or die "Can't seek tmpfile"; |
135 |
144 |
136 $/ = "\0"; |
145 $/ = "\0"; |
137 delete $h{$_} while <$tmp>; |
146 delete $h{$_} while <$tmp>; |
138 printf "$. items %s from $db\n", |
147 printf "$. items %s from $db\n", $opt_purge ? "purged" : "deleted"; |
139 $opt_purge ? "purged" : "deleted"; |
|
140 |
148 |
141 close($tmp); |
149 close($tmp); |
142 |
150 |
143 } |
151 } |
144 exit 0; |
152 exit 0; |
145 } |
153 } |
146 |
154 |
147 if ($opt_dbs) { |
155 if ($opt_dbs) { |
148 print join("\n", getDBs(@ARGV)), "\n"; |
156 print join("\n", getDBs(@ARGV)), "\n"; |
149 exit 0; |
157 exit 0; |
150 } |
158 } |
151 |
159 |
152 if ($opt_insert) { |
160 if ($opt_insert) { |
153 print unseen(@ARGV); |
161 print unseen(@ARGV); |
154 exit 0; |
162 exit 0; |
155 } |
163 } |
156 } |
164 } |
157 |
165 |
158 sub getDBs(@) { |
166 sub getDBs(@) { |
159 grep { -f } map { m(^\.?/) ? glob($_) : glob(getDBDir() . "/$_") } @_ ? @_ : "*"; |
167 grep { -f } |
|
168 map { m(^\.?/) ? glob($_) : glob(getDBDir() . "/$_") } @_ ? @_ : "*"; |
160 } |
169 } |
161 |
170 |
162 # Helper to iterate over our hash and call the passed |
171 # Helper to iterate over our hash and call the passed |
163 # "callback" function (item, v0, v1, count) |
172 # "callback" function (item, v0, v1, count) |
164 sub iterate(\%$) { |
173 sub iterate(\%$) { |
165 my ($hash, $sub) = @_; |
174 my ($hash, $sub) = @_; |
166 while (my ($k, $v) = each %$hash) { |
175 while (my ($k, $v) = each %$hash) { |
167 chop($k, $v); |
176 chop($k, $v); |
168 &$sub($k, (split(" ", $v), 0)[0..2]); # 0 for filling |
177 &$sub($k, (split(" ", $v), 0)[ 0 .. 2 ]); # 0 for filling |
169 } |
178 } |
170 } |
179 } |
171 |
180 |
172 |
|
173 # vim:ft=perl aw sts=4 sw=4: |
181 # vim:ft=perl aw sts=4 sw=4: |