--- a/bin/checker Thu Jul 28 10:03:15 2011 +0200
+++ b/bin/checker Thu Jul 28 11:12:38 2011 +0200
@@ -18,22 +18,32 @@
sub check_images;
my %o = (
- yes => undef,
+ yes => undef,
verbose => undef,
- check => undef,
-); lock_keys(%o);
+ check => undef,
+);
+lock_keys(%o);
MAIN: {
Getopt::Long::Configure qw(Bundling);
GetOptions(
- "y|yes!" => \$o{yes},
- "v|verbose!" => \$o{verbose},
- "c|check" => \$o{check},
- "h|help" => sub { pod2usage(-verbose => 1, -exit 0) },
- "m|man" => sub { pod2usage(-verbose => 2, -exit 0,
- -noperldoc => system("perldoc -V 1>/dev/null
- 2>&1"))},
- ) and @ARGV or pod2usage;
+ "y|yes!" => \$o{yes},
+ "v|verbose!" => \$o{verbose},
+ "c|check" => \$o{check},
+ "h|help" => sub { pod2usage(-verbose => 1, -exit 0) },
+ "m|man" => sub {
+ pod2usage(
+ -verbose => 2,
+ -exit 0,
+ -noperldoc => system(
+ "perldoc -V 1>/dev/null
+ 2>&1"
+ )
+ );
+ },
+ )
+ and @ARGV
+ or pod2usage;
my $dir = shift;
my $tmp = File::Temp->new;
@@ -43,8 +53,10 @@
my %block = get_block_list($dir);
verbose("# indexed: "
- . scalar(@{$block{""}//[]}) . " images with "
- . (grep !/^\.idx$/ => keys(%block))." blocks");
+ . scalar(@{ $block{""} // [] })
+ . " images with "
+ . (grep !/^\.idx$/ => keys(%block))
+ . " blocks");
purge_unused($dir => %block);
check_images($dir => %block);
@@ -58,7 +70,7 @@
open(my $fh => $list);
while (<$fh>) {
- push @files, (split)[2];
+ push @files, (split)[2];
}
return grep /^[a-z\d.\/]+$/ => @files;
}
@@ -66,13 +78,16 @@
sub get_block_list {
my $dir = shift;
my %block;
- find(sub {
- (-f) or return; # we need to include the tmp files!
- push @{$block{""}}, abs_path $_;
- foreach my $f (get_file_list($_)) {
- push @{$block{$f}} => $#{$block{""}};
- }
- }, "$dir/idx");
+ find(
+ sub {
+ (-f) or return; # we need to include the tmp files!
+ push @{ $block{""} }, abs_path $_;
+ foreach my $f (get_file_list($_)) {
+ push @{ $block{$f} } => $#{ $block{""} };
+ }
+ },
+ "$dir/idx"
+ );
return %block;
}
@@ -84,68 +99,73 @@
verbose("# pass 1 - estimating file count");
# calculate the number of files we expect
- find(sub {
- -d or return;
- opendir(my $dh => $_);
- map { $total++ if not $_ ~~ [qw<. ..>] and length > 8} readdir $dh;
- closedir($dh);
- }, "$dir/data");
-
+ find(
+ sub {
+ -d or return;
+ opendir(my $dh => $_);
+ map { $total++ if not $_ ~~ [qw<. ..>] and length > 8 } readdir $dh;
+ closedir($dh);
+ },
+ "$dir/data"
+ );
# progress
local $SIG{ALRM} = sub {
- return alarm 1 if not $done;
- my $speed = $done / (time - $^T + 1);
- verbose sprintf "# pass 1 done %5.1f%% | %25s (%*d of %d blocks)",
- 100 * ($done/$total),
- scalar(localtime($^T + $speed * ($total - $done))),
- length($total) => $done,
- $total;
- alarm 5;
+ return alarm 1 if not $done;
+ my $speed = $done / (time - $^T + 1);
+ verbose sprintf "# pass 1 done %5.1f%% | %25s (%*d of %d blocks)",
+ 100 * ($done / $total),
+ scalar(localtime($^T + $speed * ($total - $done))),
+ length($total) => $done,
+ $total;
+ alarm 5;
};
$SIG{ALRM}->();
my @unused;
- find(sub {
- $done++ if -f;
- (-f _) and ((-M _) > 0) or return; # don't process the fresh blocks
+ find(
+ sub {
+ $done++ if -f;
+ (-f _) and ((-M _) > 0) or return; # don't process the fresh blocks
- # we don't need uncompressed files if an compressed version
- # exists
- unlink $_ and return if -f "$_.gz";
+ # we don't need uncompressed files if an compressed version
+ # exists
+ unlink $_ and return if -f "$_.gz";
- # cut away the first part of the filename and
- # some optional extension
- (my $rn = $File::Find::name) =~ s/^$dir\/data\/(.*?)(?:\..+)?$/$1/;
- exists $block{$rn} and return;
- push @unused, abs_path $File::Find::name;
- return;
+ # cut away the first part of the filename and
+ # some optional extension
+ (my $rn = $File::Find::name) =~ s/^$dir\/data\/(.*?)(?:\..+)?$/$1/;
+ exists $block{$rn} and return;
+ push @unused, abs_path $File::Find::name;
+ return;
- }, "$dir/data");
+ },
+ "$dir/data"
+ );
$SIG{ALRM}->();
alarm 0;
return if not @unused;
say sprintf "found %d (%.1f%%) unused files",
- 0+@unused,
- 100 * (@unused/$total);
+ 0 + @unused,
+ 100 * (@unused / $total);
if ($o{yes}) {
- verbose("# deleting ".@unused." files");
- unlink @unused;
- return;
+ verbose("# deleting " . @unused . " files");
+ unlink @unused;
+ return;
}
if (-t) {
- while(1) {
- print "delete? [y/N/v]: ";
- given (<STDIN>) {
- when (/^y(?:es)?$/i) { unlink @unused; last }
- when (/^v/) { say join "\n", @unused; next }
- default { last }
- }
- }
+ while (1) {
+ print "delete? [y/N/v]: ";
+ given (<STDIN>) {
+ when (/^y(?:es)?$/i) { unlink @unused; last }
+ when (/^v/) { say join "\n", @unused; next }
+ default { last }
+ }
+ }
}
}
@@ -160,53 +180,54 @@
# progress
local $SIG{ALRM} = sub {
- return alarm 1 if not $done;
- my $speed = $done / (time - $^T + 1);
- verbose sprintf "# pass 2 done %5.1f%% | %25s (%*d of %d blocks)",
- 100 * $done/$total,
- scalar(localtime($^T + ($total - $done) * $speed)),
- length($total) => $done,
- $total;
- alarm 5;
+ return alarm 1 if not $done;
+ my $speed = $done / (time - $^T + 1);
+ verbose sprintf "# pass 2 done %5.1f%% | %25s (%*d of %d blocks)",
+ 100 * $done / $total,
+ scalar(localtime($^T + ($total - $done) * $speed)),
+ length($total) => $done,
+ $total;
+ alarm 5;
};
$SIG{ALRM}->();
my %invalid;
foreach my $k (keys %block) {
- my $i = $block{$k};
- next if $k eq "";
- ++$done;
-
- next if -f "$dir/data/$k"
- or -f "$dir/data/$k.gz";
- say "missing $k @$i";
- @invalid{@$i} = ();
+ my $i = $block{$k};
+ next if $k eq "";
+ ++$done;
+
+ next
+ if -f "$dir/data/$k"
+ or -f "$dir/data/$k.gz";
+ say "missing $k @$i";
+ @invalid{@$i} = ();
}
$SIG{ALRM}->();
alarm 0;
# invalid now contains the numbers of the idx files beiing
# invalid
- my @invalid = sort @{$block{""}}[keys %invalid];
+ my @invalid = sort @{ $block{""} }[keys %invalid];
return if not @invalid;
say sprintf "found %d (%.1f%%) invalid images:",
- 0+@invalid,
- 100 * (@invalid/$total);
+ 0 + @invalid,
+ 100 * (@invalid / $total);
if ($o{yes}) {
- unlink @invalid;
- return;
+ unlink @invalid;
+ return;
}
while (-t) {
- print "delete? [y/N/v] ";
- given (<STDIN>) {
- when (/^y(?:es)?$/i) { unlink @invalid; last }
- when (/^v/i) { say join "\n" => @invalid; next }
- default { last }
- }
+ print "delete? [y/N/v] ";
+ given (<STDIN>) {
+ when (/^y(?:es)?$/i) { unlink @invalid; last }
+ when (/^v/i) { say join "\n" => @invalid; next }
+ default { last }
+ }
}
}
__END__