1 #! /usr/bin/perl

     2 

     3 use 5.010;

     4 use strict;

     5 use warnings;

     6 use Pod::Usage;

     7 use Hash::Util qw(lock_keys);

     8 use File::Find;

     9 use File::Temp;

    10 use DB_File;

    11 use File::Basename;

    12 use autodie qw(:all);

    13 use Cwd qw(abs_path);

    14 

    15 use Getopt::Long;

    16 

    17 my %o = (

    18     dry => undef,

    19     verbose => undef,

    20     check => undef,

    21 ); lock_keys(%o);

    22 

    23 MAIN: {

    24     Getopt::Long::Configure qw(Bundling);

    25     GetOptions(

    26 	"n|dry!" => \$o{dry},

    27 	"v|verbose!" => \$o{verbose},

    28 	"c|check" => \$o{check},

    29 	"h|help" => sub { pod2usage(-verbose => 1, -exit 0) },

    30 	"m|man"  => sub { pod2usage(-verbose => 2, -exit 0, 

    31 			  -noperldoc => system("perldoc -V 1>/dev/null

    32 			  2>&1"))},

    33     ) and @ARGV or pod2usage;

    34     my $dir = shift;

    35     my $tmp = File::Temp->new;

    36 

    37     # load the index files, remember the latest

    38     # timestamp we see

    39     my (%inuse, @idx);

    40     #tie %idx, "DB_File" => $tmp->filename;

    41 

    42     find(sub {

    43 	(-f) and (-M > 0) or return;

    44 	#verbose("idx: $File::Find::name");

    45 	push @idx, abs_path $_;

    46 	foreach my $f (get_file_list($_)) {

    47 	    push @{$inuse{$f}} => $#idx;

    48 	}

    49     }, "$dir/idx");

    50 

    51     verbose("indexed: ".scalar(keys %inuse)." files");

    52 

    53     # simple "forward" check: existence of mentioned files

    54     if ($o{check}) {

    55 	my $total = scalar keys %inuse;

    56 	my $done = 0;

    57 	local $SIG{ALRM} = sub {

    58 	    say sprintf "done %5.1f%% (%*d of $total)" 

    59 		=> 100 * $done/$total, length($total), $done

    60 		if $total;

    61 	    alarm 5;

    62 	};

    63 	$SIG{ALRM}->();

    64 	while (my ($f, $i) = each %inuse) {

    65 	    ++$done;

    66 	    next if -f "$dir/data/$f"

    67 		or -f "$dir/data/$f.gz";

    68 	    say "missing $f from\n",

    69 		join "-\t" => "", map { "$_\n" } @idx[@$i];

    70 	}

    71 	$SIG{ALRM}->();

    72 	alarm 0;

    73 	exit 0;

    74     }

    75 

    76     # full check and probably cleaning: all files, not mentioned

    77     # in some index will be purged

    78 #   my (%file);

    79 #-    find(sub {

    80 #-	(-f) and (-M > 0) or return;

    81 #-	$File::Find::name =~ s/^$dir\/data\///;

    82 #-	$file{$_} = $_;

    83 #-    }, "$dir/data");

    84 #-

    85 #-    verbose("file system: ".scalar(keys %file)." files");

    86 #-    exit 0;

    87 

    88     # ok, now go through all the data files and remove

    89     # files not mentioned in some index, but never remove

    90     # files created after the cleaner started

    91     find(sub {

    92 	(-f) and (-M > 0) or return;

    93 

    94 	# cut away the first part of the filename and

    95 	# some optional extension

    96 	(my $rn = $File::Find::name) =~ s/^$dir\/data\/(.*?)(?:\..+)?$/$1/;

    97 	exists $inuse{$rn} and return;

    98 

    99 	if ($o{dry}) {

   100 	    verbose("(unlinking) abs_path $File::Find::name");

   101 	    return;

   102 	}

   103 

   104 	verbose("unlinking abs_path $File::Find::name");

   105 	unlink abs_path $File::Find::name;

   106 

   107     }, "$dir/data");

   108 

   109 }

   110 

   111 sub verbose { say @_ if $o{verbose} }

   112 

   113 sub get_file_list {

   114     my ($list) = @_;

   115     my @files = ();

   116 

   117     open(my $fh => $list);

   118     while (<$fh>) {

   119 	push @files, (split)[2];

   120     }

   121     return grep /^[a-z\d.\/]+$/ => @files;

   122 }

   123 

   124 

   125 __END__

   126 

   127 =head1 NAME

   128 

   129     cleaner - cleans the imager data directory

   130 

   131 =head1 SYNOPSIS

   132 

   133     cleaner [options] {directory}

   134 

   135 =head1 DESCRIPTION

   136 

   137 This tool loads all the index files from I<directory>F</idx/>

   138 and purges all not mentioned files below I<directory>F</data/>.

   139 

   140 =head1 OPTIONS

   141 

   142 =over

   143 

   144 =item B<-c>|B<--check>

   145 

   146 Check (and exit) if nothing is missing.

   147 

   148 =item B<-n>|B<--dry>

   149 

   150 Do nothing, just print what should be removed. (default: off)

   151 

   152 =item B<-h>|B<--help>

   153 

   154 =item B<-m>|B<--man>

   155 

   156 The short and longer help.

   157 

   158 =back

   159 

   160 =cut