repair broken diagnostics
[rersyncrecent.git] / bin / rrr-init
blob524a1e0592e8e64516d28999df7138ab137a6ee3
1 #!/usr/bin/perl
3 =head1 NAME
5 rrr-init - set up RECENT files for a directory tree
7 =head1 SYNOPSIS
9 rrr-init [options] directory
11 =head1 OPTIONS
13 =over 8
15 =cut
17 my @opt = <<'=back' =~ /B<--(\S+)>/g;
19 =item B<--aggregator=s>
21 Comma separated list of aggregator specifications, e.g.
23 --aggregator=1h,6h,1d,1W,1M,1Q,1Y,Z
25 Defaults to C<1h,1d,1M,1Y,Z>
27 =item B<--force|f>
29 Forces an overwrite of an already existing recentfile in the target
30 directory.
32 =item B<--help|h>
34 Prints a brief message and exists.
36 =item B<--serializer_suffix=s>
38 Defaults to C<.yaml>. Supported values are listed in
39 L<File::Rsync::Mirror::Recentfile> under the heading SERIALIZERS.
41 =item B<--verbose|v+>
43 More feedback.
45 =back
47 =head1 DESCRIPTION
49 Walk through a tree and fill all files into initial recentfiles.
51 =cut
54 use strict;
55 use warnings;
57 use File::Find::Rule;
58 use lib "/home/k/sources/rersyncrecent/lib";
59 use File::Rsync::Mirror::Recent;
60 use File::Rsync::Mirror::Recentfile;
61 use File::Spec;
62 use Getopt::Long;
63 use Pod::Usage qw(pod2usage);
64 use Time::HiRes qw(time);
66 our %Opt;
67 GetOptions(\%Opt,
68 @opt,
69 ) or pod2usage(1);
71 if ($Opt{help}) {
72 pod2usage(0);
75 if (@ARGV != 1) {
76 pod2usage(1);
79 if ($Opt{verbose}) {
80 # speed up fail on missing module:
81 require Time::Progress;
84 my($rootdir) = @ARGV;
85 my $aggregator_string = $Opt{aggregator} || "1h,1d,1M,1Y,Z";
86 my @aggregator = split /\s*,\s*/, $aggregator_string;
87 my $localroot = File::Spec->rel2abs($rootdir);
88 my $rfconstructor = sub {
89 return File::Rsync::Mirror::Recentfile->new
91 aggregator => \@aggregator,
92 interval => $aggregator[0],
93 localroot => $localroot,
94 verbose => $Opt{verbose},
95 serializer_suffix => $Opt{serializer_suffix},
98 my $rf = $rfconstructor->();
99 my $rfilename = File::Spec->catfile
101 $rootdir,
102 $rf->rfilename,
105 if (-e $rfilename) {
106 if ($Opt{force}) {
107 unlink $rfilename or die sprintf "Could not unlink '%s': %s", $rfilename, $!;
108 $rf = $rfconstructor->();
109 } else {
110 die sprintf "Alert: Found an already existing file '%s'. Won't overwrite. Either use --force or remove the file before calling me again", $rfilename;
112 } else {
113 warn "Debug: rfilename[$rfilename]";
115 my @t = time;
116 my @batch;
117 foreach my $file ( File::Find::Rule->new->file->in($rootdir) ) {
118 my $path = File::Spec->rel2abs($file);
119 my $epoch = (stat $path)[9];
120 push @batch, {path=>$path,type=>"new",epoch=>$epoch};
122 if ($Opt{verbose}) {
123 $t[1] = time;
124 warn sprintf "Found %d files to register in %.6f s. Writing to %s\n", scalar @batch, $t[1]-$t[0], $rfilename;
126 $rf->batch_update(\@batch);
127 if ($Opt{verbose}) {
128 $t[2] = time;
129 warn sprintf "Registered %d files in %.6f s\n", scalar @batch, $t[2]-$t[1];
132 __END__
135 # Local Variables:
136 # mode: cperl
137 # coding: utf-8
138 # cperl-indent-level: 4
139 # End: