bin/rrr-init

   1 #!/usr/bin/perl
   2
   3 =head1 NAME
   4
   5 rrr-init - set up RECENT files for a directory tree
   6
   7 =head1 SYNOPSIS
   8
   9   rrr-init [options] directory
  10
  11 =head1 OPTIONS
  12
  13 =over 8
  14
  15 =cut
  16
  17 my @opt = <<'=back' =~ /B<--(\S+)>/g;
  18
  19 =item B<--aggregator=s>
  20
  21 Comma separated list of aggregator specifications, e.g.
  22
  23   --aggregator=1h,6h,1d,1W,1M,1Q,1Y,Z
  24
  25 Defaults to C<1h,1d,1M,1Y,Z>
  26
  27 =item B<--force|f>
  28
  29 Forces an overwrite of an already existing recentfile in the target
  30 directory.
  31
  32 =item B<--help|h>
  33
  34 Prints a brief message and exists.
  35
  36 =item B<--serializer_suffix=s>
  37
  38 Defaults to C<.yaml>. Supported values are listed in
  39 L<File::Rsync::Mirror::Recentfile> under the heading SERIALIZERS.
  40
  41 =item B<--verbose|v+>
  42
  43 More feedback.
  44
  45 =back
  46
  47 =head1 DESCRIPTION
  48
  49 Walk through a tree and fill all files into initial recentfiles.
  50
  51 =cut
  52
  53
  54 use strict;
  55 use warnings;
  56
  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);
  65
  66 our %Opt;
  67 GetOptions(\%Opt,
  68            @opt,
  69           ) or pod2usage(1);
  70
  71 if ($Opt{help}) {
  72     pod2usage(0);
  73 }
  74
  75 if (@ARGV != 1) {
  76     pod2usage(1);
  77 }
  78
  79 if ($Opt{verbose}) {
  80     # speed up fail on missing module:
  81     require Time::Progress;
  82 }
  83
  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
  90           (
  91            aggregator => \@aggregator,
  92            interval => $aggregator[0],
  93            localroot => $localroot,
  94            verbose => $Opt{verbose},
  95            serializer_suffix => $Opt{serializer_suffix},
  96           );
  97 };
  98 my $rf = $rfconstructor->();
  99 my $rfilename = File::Spec->catfile
 100     (
 101      $rootdir,
 102      $rf->rfilename,
 103     );
 104
 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;
 111     }
 112 } else {
 113     warn "Debug: rfilename[$rfilename]";
 114 }
 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};
 121 }
 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;
 125 }
 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];
 130 }
 131
 132 __END__
 133
 134
 135 # Local Variables:
 136 # mode: cperl
 137 # coding: utf-8
 138 # cperl-indent-level: 4
 139 # End: