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 exits.
  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. Requires Time::Progress installed.
  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 File::Rsync::Mirror::Recent;
  59 use File::Rsync::Mirror::Recentfile;
  60 use File::Spec;
  61 use Getopt::Long;
  62 use Pod::Usage qw(pod2usage);
  63 use Time::HiRes qw(time);
  64
  65 our %Opt;
  66 GetOptions(\%Opt,
  67            @opt,
  68           ) or pod2usage(1);
  69
  70 if ($Opt{help}) {
  71     pod2usage(0);
  72 }
  73
  74 if (@ARGV != 1) {
  75     pod2usage(1);
  76 }
  77
  78 if ($Opt{verbose}) {
  79     # speed up fail on missing module:
  80     require Time::Progress;
  81 }
  82
  83 my($rootdir) = @ARGV;
  84 my $aggregator_string = $Opt{aggregator} || "1h,1d,1M,1Y,Z";
  85 my @aggregator = split /\s*,\s*/, $aggregator_string;
  86 my $localroot = File::Spec->rel2abs($rootdir);
  87 my $rfconstructor = sub {
  88     return File::Rsync::Mirror::Recentfile->new
  89           (
  90            aggregator => \@aggregator,
  91            interval => $aggregator[0],
  92            localroot => $localroot,
  93            verbose => $Opt{verbose},
  94            serializer_suffix => $Opt{serializer_suffix},
  95           );
  96 };
  97 my $rf = $rfconstructor->();
  98 my $rfilename = File::Spec->catfile
  99     (
 100      $rootdir,
 101      $rf->rfilename,
 102     );
 103
 104 if (-e $rfilename) {
 105     if ($Opt{force}) {
 106         unlink $rfilename or die sprintf "Could not unlink '%s': %s", $rfilename, $!;
 107         $rf = $rfconstructor->();
 108     } else {
 109         die sprintf "Alert: Found an already existing file '%s'. Won't overwrite. Either use --force or remove the file before calling me again", $rfilename;
 110     }
 111 }
 112 my @t = time;
 113 my @batch;
 114 foreach my $file ( File::Find::Rule->new->file->in($rootdir) ) {
 115     my $path = File::Spec->rel2abs($file);
 116     my $epoch = (lstat $path)[9];
 117     push @batch, {path=>$path,type=>"new",epoch=>$epoch};
 118 }
 119 if ($Opt{verbose}) {
 120     $t[1] = time;
 121     warn sprintf "Found %d files to register in %.6f s. Writing to %s\n", scalar @batch, $t[1]-$t[0], $rfilename;
 122 }
 123 $rf->batch_update(\@batch);
 124 if ($Opt{verbose}) {
 125     $t[2] = time;
 126     warn sprintf "Registered %d files in %.6f s\n", scalar @batch, $t[2]-$t[1];
 127 }
 128
 129 __END__
 130
 131
 132 # Local Variables:
 133 # mode: cperl
 134 # coding: utf-8
 135 # cperl-indent-level: 4
 136 # End: