bin/rrr-server

   1 #!/usr/bin/perl -- -*- mode: cperl -*-
   2
   3 =head1 NAME
   4
   5 rrr-server - watch a tree and update indexfiles
   6
   7 =head1 SYNOPSIS
   8
   9   rrr-server [options] principalfile
  10
  11 =head1 OPTIONS
  12
  13 =over 8
  14
  15 =cut
  16
  17 my @opt = <<'=back' =~ /B<--(\S+)>/g;
  18
  19 =item B<--help|h>
  20
  21 Prints a brief message and exists.
  22
  23 =item B<--verbose|v+>
  24
  25 More feedback.
  26
  27 =back
  28
  29 =head1 DESCRIPTION
  30
  31 After you have setup a tree watch it with inotify and keep it
  32 uptodate. Depends on inotify which probably only exists on linux.
  33
  34 =head1 PREREQUISITE
  35
  36 Linux::Inotify2.
  37
  38 It is not declared as prerequisites of the F:R:M:Recent package
  39 because there are so many ways to use the package so that server side
  40 is considered optional.
  41
  42 =cut
  43
  44 use strict;
  45 use warnings;
  46
  47 use File::Find qw(find);
  48 use lib "/home/k/sources/rersyncrecent/lib";
  49 use File::Rsync::Mirror::Recent;
  50 use File::Spec;
  51 use Getopt::Long;
  52 use Pod::Usage qw(pod2usage);
  53 use Time::HiRes qw(time);
  54
  55 our %Opt;
  56 GetOptions(\%Opt,
  57            @opt,
  58           ) or pod2usage(1);
  59
  60 if ($Opt{help}) {
  61     pod2usage(0);
  62 }
  63
  64 if (@ARGV != 1) {
  65     pod2usage(1);
  66 }
  67
  68 my($principal) = @ARGV;
  69 my $recc = File::Rsync::Mirror::Recent->new
  70     (local => $principal);
  71 my($rf) = $recc->principal_recentfile;
  72 my $rootdir = $rf->localroot;
  73 for my $req (qw(Linux::Inotify2 File::Find::Rule)) {
  74     eval qq{ require $req; 1 };
  75     if ($@) {
  76         die "Failing on 'require $req': $@"
  77     } else {
  78         $req->import;
  79     }
  80 }
  81
  82 my $inotify = new Linux::Inotify2
  83     or die "Unable to create new inotify object: $!";
  84
  85 foreach my $directory ( File::Find::Rule->new->directory->in($rootdir) ) {
  86     $inotify->watch( $directory, IN_MODIFY()|IN_MOVED_FROM()|IN_MOVED_TO()|IN_CREATE()|IN_DELETE()|IN_DELETE_SELF()|IN_MOVE_SELF() )
  87         or die "watch creation failed";
  88 }
  89
  90
  91 my $i;
  92 my $in_callback = sub {
  93     my $ev = shift;
  94     my @stringifiedmask;
  95     for my $watch (qw(IN_MODIFY IN_MOVED_FROM IN_MOVED_TO IN_CREATE IN_DELETE IN_DELETE_SELF IN_MOVE_SELF)) {
  96         push @stringifiedmask, $watch if $ev->$watch();
  97     }
  98     warn sprintf "%s %s %s %s %s %s", ++$i, time, $ev->w->name, $ev->name, $ev->fullname, join("|",@stringifiedmask);
  99 };
 100
 101 while () {
 102     my @events = $inotify->read;
 103     unless ( @events > 0 ) {
 104         print "read error: $!";
 105         last;
 106     }
 107     foreach my $event (@events) {
 108         $in_callback->($event);
 109     }
 110     # no sleep necessary, read is blocking
 111 }
 112
 113 __END__
 114
 115
 116 # Local Variables:
 117 # mode: cperl
 118 # coding: utf-8
 119 # cperl-indent-level: 4
 120 # End: