diff -r 49ff641055a3 -r e0f19213f8b6 bin/checker --- 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 () { - when (/^y(?:es)?$/i) { unlink @unused; last } - when (/^v/) { say join "\n", @unused; next } - default { last } - } - } + while (1) { + print "delete? [y/N/v]: "; + given () { + 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 () { - when (/^y(?:es)?$/i) { unlink @invalid; last } - when (/^v/i) { say join "\n" => @invalid; next } - default { last } - } + print "delete? [y/N/v] "; + given () { + when (/^y(?:es)?$/i) { unlink @invalid; last } + when (/^v/i) { say join "\n" => @invalid; next } + default { last } + } } } __END__