79 |
79 |
80 sub purge_unused { |
80 sub purge_unused { |
81 my ($dir, %block) = @_; |
81 my ($dir, %block) = @_; |
82 |
82 |
83 my ($total, $done); |
83 my ($total, $done); |
84 verbose("# pass 1 - purge unused blocks"); |
84 verbose("# pass 1 - checking for unused blocks"); |
|
85 verbose("# estimating file count"); |
85 |
86 |
86 # calculate the number of files we expect |
87 # calculate the number of files we expect |
87 find(sub { |
88 find(sub { |
88 -d or return; |
89 -d or return; |
89 opendir(my $dh => $_); |
90 opendir(my $dh => $_); |
103 $total; |
104 $total; |
104 alarm 5; |
105 alarm 5; |
105 }; |
106 }; |
106 $SIG{ALRM}->(); |
107 $SIG{ALRM}->(); |
107 |
108 |
|
109 my @unused; |
108 find(sub { |
110 find(sub { |
109 $done++ if -f; |
111 $done++ if -f; |
110 (-f _) and ((-M _) > 0) or return; |
112 (-f _) and ((-M _) > 0) or return; |
|
113 |
|
114 # we don't need uncompressed files if an compressed version |
|
115 # exists |
|
116 unlink $_ and return if -f "$_.gz"; |
111 |
117 |
112 # cut away the first part of the filename and |
118 # cut away the first part of the filename and |
113 # some optional extension |
119 # some optional extension |
114 (my $rn = $File::Find::name) =~ s/^$dir\/data\/(.*?)(?:\..+)?$/$1/; |
120 (my $rn = $File::Find::name) =~ s/^$dir\/data\/(.*?)(?:\..+)?$/$1/; |
115 exists $block{$rn} and return; |
121 exists $block{$rn} and return; |
116 |
122 push @unused, abs_path $File::Find::name; |
117 |
123 return; |
118 if ($o{yes}) { |
124 |
119 verbose("unlinking " . abs_path $File::Find::name); |
125 }, "$dir/data"); |
120 unlink abs_path $File::Find::name; |
126 $SIG{ALRM}->(); |
121 return; |
127 alarm 0; |
|
128 |
|
129 return if not @unused; |
|
130 |
|
131 say sprintf "found %d (%.1f%%) unused files", |
|
132 0+@unused, |
|
133 100 * (@unused/$total); |
|
134 |
|
135 if ($o{yes}) { |
|
136 verbose("# deleting ".@unused." files"); |
|
137 unlink @unused; |
|
138 return; |
|
139 } |
|
140 |
|
141 if (-t) { |
|
142 while(1) { |
|
143 print "delete? [y/N/v]: "; |
|
144 given (<STDIN>) { |
|
145 when (/^y(?:es)?$/i) { unlink @unused; last } |
|
146 when (/^v/) { say join "\n", @unused; next } |
|
147 default { last } |
|
148 } |
122 } |
149 } |
123 |
150 } |
124 verbose("unused " . abs_path $File::Find::name); |
|
125 return; |
|
126 |
|
127 }, "$dir/data"); |
|
128 $SIG{ALRM}->(); |
|
129 alarm 0; |
|
130 |
151 |
131 } |
152 } |
132 |
153 |
133 sub check_images { |
154 sub check_images { |
134 my ($dir, %block) = @_; |
155 my ($dir, %block) = @_; |
157 next if $k eq ""; |
178 next if $k eq ""; |
158 ++$done; |
179 ++$done; |
159 |
180 |
160 next if -f "$dir/data/$k" |
181 next if -f "$dir/data/$k" |
161 or -f "$dir/data/$k.gz"; |
182 or -f "$dir/data/$k.gz"; |
162 say "missing $k"; |
183 say "missing $k @$i"; |
163 @invalid{@{$block{""}}} = (); |
184 @invalid{@$i} = (); |
164 } |
185 } |
165 $SIG{ALRM}->(); |
186 $SIG{ALRM}->(); |
166 alarm 0; |
187 alarm 0; |
167 |
188 |
168 return if not %invalid; |
189 # invalid now contains the numbers of the idx files beiing |
169 |
190 # invalid |
170 say "invalid images:\n", join "\n", sort keys %invalid; |
191 my @invalid = sort @{$block{""}}[keys %invalid]; |
171 unlink keys %invalid if $o{yes}; |
192 |
|
193 return if not @invalid; |
|
194 |
|
195 say sprintf "found %d (%.1f%%) invalid images:", |
|
196 0+@invalid, |
|
197 100 * (@invalid/$total); |
|
198 |
|
199 if ($o{yes}) { |
|
200 unlink @invalid; |
|
201 return; |
|
202 } |
|
203 |
|
204 while (-t) { |
|
205 print "delete? [y/N/v] "; |
|
206 given (<STDIN>) { |
|
207 when (/^y(?:es)?$/i) { unlink @invalid; last } |
|
208 when (/^v/i) { say join "\n" => @invalid; next } |
|
209 default { last } |
|
210 } |
|
211 } |
172 } |
212 } |
173 __END__ |
213 __END__ |
174 |
214 |
175 =head1 NAME |
215 =head1 NAME |
176 |
216 |