43 }, |
43 }, |
44 ) |
44 ) |
45 and @ARGV |
45 and @ARGV |
46 or pod2usage; |
46 or pod2usage; |
47 my $dir = shift; |
47 my $dir = shift; |
48 my $tmp = File::Temp->new; |
48 |
49 |
49 while (1) { |
50 # load the index files, remember the latest |
50 my %block = get_block_list($dir); |
51 # timestamp we see |
51 |
52 #tie %idx, "DB_File" => $tmp->filename; |
52 verbose("# reading index files"); |
53 verbose("# reading index files"); |
53 verbose("# indexed: " |
54 my %block = get_block_list($dir); |
54 . scalar(@{ $block{""} // [] }) |
55 |
55 . " images with " |
56 verbose("# indexed: " |
56 . (grep !/^\.idx$/ => keys(%block)) |
57 . scalar(@{ $block{""} // [] }) |
57 . " blocks"); |
58 . " images with " |
58 |
59 . (grep !/^\.idx$/ => keys(%block)) |
59 purge_unused($dir => %block); |
60 . " blocks"); |
60 check_images($dir => %block) and last; |
61 |
61 |
62 purge_unused($dir => %block); |
62 verbose("# STARTING OVER!"); |
63 check_images($dir => %block); |
63 } |
64 } |
64 } |
65 |
65 |
66 sub verbose { say @_ if $o{verbose} } |
66 sub verbose { say @_ if $o{verbose} } |
67 |
67 |
68 sub get_file_list { |
68 sub get_file_list { |
92 return %block; |
92 return %block; |
93 } |
93 } |
94 |
94 |
95 sub purge_unused { |
95 sub purge_unused { |
96 my ($dir, %block) = @_; |
96 my ($dir, %block) = @_; |
97 |
|
98 my ($total, $done, $t0); |
97 my ($total, $done, $t0); |
99 verbose("# pass 1 - checking for unused blocks"); |
98 state $subpass = -1; |
|
99 |
|
100 verbose("# pass 1.@{[++$subpass]} - checking for unused blocks"); |
100 verbose("# estimating file count"); |
101 verbose("# estimating file count"); |
101 |
102 |
102 # calculate the number of files we expect |
103 # calculate the number of files we expect |
103 find( |
104 find( |
104 sub { |
105 sub { |
105 -d or return; |
106 -d or return; |
106 opendir(my $dh => $_); |
107 opendir(my $dh => $_); |
107 map { $total++ if not $_ ~~ [qw<. ..>] and length > 8 } readdir $dh; |
108 map { $total++ if not $_ ~~ [qw<. ..>] and length > 8 } readdir $dh; |
108 closedir($dh); |
109 closedir($dh); |
109 $File::Find::prune = $_ =~ /^[\d[a-f]{3}$/; # FIXME should be configurable |
110 $File::Find::prune = |
|
111 $_ =~ /^[\d[a-f]{3}$/; # FIXME should be configurable |
110 }, |
112 }, |
111 "$dir/data" |
113 "$dir/data" |
112 ); |
114 ); |
113 verbose("# got $total blocks/files"); |
115 verbose("# got $total blocks/files"); |
114 |
116 |
115 # progress |
117 # progress |
116 $t0 = time; |
118 $t0 = time; |
117 local $SIG{ALRM} = sub { |
119 local $SIG{ALRM} = sub { |
118 return alarm 1 if not $done; |
120 return alarm 1 if not $done; |
119 my $speed = $done / (time - $t0 + 1); |
121 my $speed = $done / (time - $t0 + 1); |
120 verbose sprintf "# pass 1 done %5.1f%% | %25s (%*d of %d blocks)", |
122 verbose sprintf |
|
123 "# pass 1.$subpass done %5.1f%% | %25s (%*d of %d blocks)", |
121 100 * ($done / $total), |
124 100 * ($done / $total), |
122 scalar(localtime $t0 + $total/$speed), |
125 scalar(localtime $t0 + $total / $speed), length($total) => $done, |
123 length($total) => $done, |
|
124 $total; |
126 $total; |
125 alarm 5; |
127 alarm 5; |
126 }; |
128 }; |
127 $SIG{ALRM}->(); |
129 $SIG{ALRM}->(); |
128 |
130 |
181 |
183 |
182 sub check_images { |
184 sub check_images { |
183 my ($dir, %block) = @_; |
185 my ($dir, %block) = @_; |
184 |
186 |
185 my $total = grep { $_ ne "" } keys(%block); |
187 my $total = grep { $_ ne "" } keys(%block); |
186 my $done = 0; |
188 my $done = 0; |
187 my $t0 = time; |
189 my $t0 = time; |
188 |
190 |
189 verbose("# pass 2 - checking image completeness"); |
191 state $subpass = -1; |
|
192 verbose("# pass 2.@{[++$subpass]} - checking image completeness"); |
190 |
193 |
191 # progress |
194 # progress |
192 local $SIG{ALRM} = sub { |
195 local $SIG{ALRM} = sub { |
193 return alarm 1 if not $done; |
196 return alarm 1 if not $done; |
194 my $speed = $done / (time - $t0 + 1); |
197 my $speed = $done / (time - $t0 + 1); |
195 verbose sprintf "# pass 2 done %5.1f%% | %25s (%*d of %d blocks)", |
198 verbose sprintf |
|
199 "# pass 2.$subpass done %5.1f%% | %25s (%*d of %d blocks)", |
196 100 * $done / $total, |
200 100 * $done / $total, |
197 scalar(localtime $t0 + $total/$speed), |
201 scalar(localtime $t0 + $total / $speed), length($total) => $done, |
198 length($total) => $done, |
|
199 $total; |
202 $total; |
200 alarm 5; |
203 alarm 5; |
201 }; |
204 }; |
202 $SIG{ALRM}->(); |
205 $SIG{ALRM}->(); |
203 |
206 |
221 |
224 |
222 # invalid now contains the numbers of the idx files beiing |
225 # invalid now contains the numbers of the idx files beiing |
223 # invalid |
226 # invalid |
224 my @invalid = sort @{ $block{""} }[keys %invalid]; |
227 my @invalid = sort @{ $block{""} }[keys %invalid]; |
225 |
228 |
226 return if not @invalid; |
229 return 1 if not @invalid; |
227 |
230 |
228 say sprintf "found %d (%.1f%%) invalid images:", |
231 say sprintf "found %d (%.1f%%) invalid images:", |
229 0 + @invalid, |
232 0 + @invalid, |
230 100 * (@invalid / $total); |
233 100 * (@invalid / $total); |
231 |
234 |
232 if ($o{yes}) { |
235 if ($o{yes}) { |
233 unlink @invalid; |
236 unlink @invalid; |
234 return; |
237 return undef; |
235 } |
238 } |
236 |
239 |
237 while (-t) { |
240 while (-t) { |
238 print "delete? [y/N/v] "; |
241 print "delete? [y/N/v] "; |
239 given (<STDIN>) { |
242 given (<STDIN>) { |
240 when (/^y(?:es)?$/i) { unlink @invalid; last } |
243 when (/^y(?:es)?$/i) { unlink @invalid; return undef } |
241 when (/^v/i) { say join "\n" => @invalid; next } |
244 when (/^v/i) { say join "\n" => @invalid; next } |
242 default { last } |
245 default { last } |
243 } |
246 } |
244 } |
247 } |
|
248 |
|
249 return 1; |
245 } |
250 } |
246 __END__ |
251 __END__ |
247 |
252 |
248 =head1 NAME |
253 =head1 NAME |
249 |
254 |