9 rrr-fsck [options] principalfile
17 my @opt = <<'=back' =~ /B<--(\S+)>/g;
21 Does nothing, only prints what it would do.
25 Prints a brief message and exits.
27 =item B<--remoteroot=s>
29 If provided fsck will try to mirror missing files from this location.
30 For remote locations requiring authentication you may need to set the
31 environment variables USER and RSYNC_PASSWORD as well.
39 Consider all answers to asked questions to be I<yes>.
45 Compares disk contents with index contents and gathers files missing
46 on local disk and files missing in local index.
48 If remoteroot is given missing files are fetched from remote.
50 Files on the local disk that have no counterpart in the index are
51 considered obsolete and the user is asked for each file if the file
52 should be deleted. And if the user confirms it will be deleted.
56 There is a race condition when the tree or the index is manipulated
57 while we are running. This implies that the result is only then 100%
58 correct when disk and index are not changed while we are running.
60 There should be an option to declare the files on disk authoritative
61 so that they are added to the index.
69 use File
::Basename
qw(dirname);
70 use File
::Find
qw(find);
71 use ExtUtils
::MakeMaker
qw(prompt);
72 use File
::Rsync
::Mirror
::Recent
;
75 use Hash
::Util
qw(lock_keys);
76 use List
::Util
qw(max);
77 use Pod
::Usage
qw(pod2usage);
78 use Time
::HiRes
qw(time sleep);
81 lock_keys
%Opt, map { /([^=|]+)/ } @opt;
95 my($principal) = @ARGV;
96 my $recc = File
::Rsync
::Mirror
::Recent
->new
99 localroot
=> dirname
$principal,
101 for my $passthrough (qw(remoteroot verbose)) {
102 if (my $opt = $Opt{$passthrough}) {
103 $recc->$passthrough($opt);
106 my $root = $recc->localroot;
107 die "Alert: Root not defined, giving up" unless defined $root;
108 my $prf = $recc->principal_recentfile;
109 my $filenameroot = $prf->filenameroot;
110 my $serializer_suffix = $prf->serializer_suffix;
111 my $ignore_rx = qr
((?x
:
112 ^ \Q
$filenameroot\E
(?
: - [0-9]*[smhdWMQYZ
] \Q
$serializer_suffix\E
(?
: \
.lock (?
: /.* )?
)?
| \
.recent
) \z
117 my $last_verbosity = 0;
124 my @lstat = lstat $_;
125 return unless -l _
or -f _
;
126 my($reportname) = $File::Find
::name
=~ m{^\Q$root\E/*(.*)};
127 return if $reportname =~ $ignore_rx;
129 if ($Opt{verbose
} && time - $last_verbosity > 0.166666) {
130 printf "\r%8d files and symlinks checked on disk ", $i;
131 $last_verbosity = time;
133 $diskfiles{$File::Find
::name
} = $lstat[9];
140 printf "\r%8d files and symlinks checked on disk\n", $i;
145 print "\rChecking index";
151 $i = scalar @
{shift;};
152 if (time - $last_verbosity > 0.166666) {
153 printf "\r%8d entries read from index ", $i;
154 $last_verbosity = time;
158 my $indexfiles = $recc->news(@newsargs);
160 printf "\r%8d entries read from index\n", scalar @
$indexfiles;
163 my %indexfiles = map {
164 ("$root/$_->{path}"=>$_->{epoch
})
166 defined $_->{path
} &&
168 && $_->{type
} eq "new"
171 my @missing_rfrfiles;
172 for my $rf (@
{$recc->recentfiles}) {
173 my $rfrfile = $rf->rfile;
174 unless (-e
$rfrfile) {
175 push @missing_rfrfiles, $rfrfile;
178 if (@missing_rfrfiles) {
179 warn "Warning: missing index files @missing_rfrfiles\n";
182 printf "\r%8d file objects found in index\n", scalar keys %indexfiles;
184 my $sprintfd = length(max
scalar @
$indexfiles, scalar keys %diskfiles);
188 $sprintfd, scalar keys %diskfiles,
189 $sprintfd, scalar keys %indexfiles,
191 my @diskmisses = sort { $indexfiles{$b} <=> $indexfiles{$a} } grep { ! exists $diskfiles{$_} } keys %indexfiles;
192 my @indexmisses = sort { $diskfiles{$a} <=> $diskfiles{$b} } grep { ! exists $indexfiles{$_} } keys %diskfiles;
194 "missing on disk: %*d\n".
195 "missing in index: %*d\n",
196 $sprintfd, scalar @diskmisses,
197 $sprintfd, scalar @indexmisses,
200 my $rf = $recc->principal_recentfile;
201 my $last_aggregate_call = time;
203 for my $dm (@diskmisses) {
205 } elsif ($Opt{"dry-run"}) {
206 if ($Opt{remoteroot
}) {
207 warn "Would fetch $dm\n";
209 warn "Would remove from indexfile $dm\n";
211 } elsif ($Opt{remoteroot
}) {
212 my $relative = substr $dm, 1 + length $root;
213 $rf->get_remotefile($relative);
215 warn "Removing from indexfile: $dm\n";
216 push @batch, {path
=> $dm, type
=> "delete"};
219 for my $im (@indexmisses) {
220 if ($Opt{"dry-run"}) {
221 if ($Opt{remoteroot
}) {
222 warn "Would remove $im\n";
224 warn "Would add to indexfile $im\n";
226 } elsif ($Opt{remoteroot
}) {
229 warn "Going to unlink '$im'\n";
232 $ans = prompt
"Unlink '$im'?", "y";
235 unlink $im or die "Could not unlink '$im': $!";
238 warn "Adding to indexfile: $im\n";
239 my @stat = lstat $im or next;
240 push @batch, {epoch
=> $stat[9], path
=> $im, type
=> "new"};
243 unless ($Opt{"dry-run"}) {
245 $rf->batch_update(\
@batch);
255 # cperl-indent-level: 4