File Coverage

blib/lib/AnyEvent/Filesys/Notify.pm
Criterion Covered Total %
statement 95 103 92.2
branch 37 42 88.1
condition 2 3 66.6
subroutine 21 26 80.7
pod 0 1 0.0
total 155 175 88.5


line stmt bran cond sub pod time code
1             package AnyEvent::Filesys::Notify;
2              
3             # ABSTRACT: An AnyEvent compatible module to monitor files/directories for changes
4              
5 11     11   433890 use Moo;
  11         95027  
  11         41  
6 11     11   14627 use Moo::Role ();
  11         58190  
  11         196  
7 11     11   3872 use MooX::late;
  11         150371  
  11         50  
8 11     11   5152 use namespace::autoclean;
  11         103209  
  11         28  
9 11     11   9430 use AnyEvent;
  11         40531  
  11         273  
10 11     11   5390 use Path::Iterator::Rule;
  11         84012  
  11         271  
11 11     11   46 use Cwd qw/abs_path/;
  11         11  
  11         438  
12 11     11   4039 use AnyEvent::Filesys::Notify::Event;
  11         28  
  11         323  
13 11     11   87 use Carp;
  11         28  
  11         489  
14 11     11   42 use Try::Tiny;
  11         21  
  11         11053  
15              
16             our $VERSION = '1.20';
17             my $AEFN = 'AnyEvent::Filesys::Notify';
18              
19             has dirs => ( is => 'ro', isa => 'ArrayRef[Str]', required => 1 );
20             has cb => ( is => 'rw', isa => 'CodeRef', required => 1 );
21             has interval => ( is => 'ro', isa => 'Num', default => 2 );
22             has no_external => ( is => 'ro', isa => 'Bool', default => 0 );
23             has backend => ( is => 'ro', isa => 'Str', default => '' );
24             has filter => ( is => 'rw', isa => 'RegexpRef|CodeRef' );
25             has parse_events => ( is => 'rw', isa => 'Bool', default => 0 );
26             has _fs_monitor => ( is => 'rw', );
27             has _old_fs => ( is => 'rw', isa => 'HashRef' );
28             has _watcher => ( is => 'rw', );
29              
30             sub BUILD {
31 11     11 0 47792 my $self = shift;
32              
33 11         49 $self->_old_fs( $self->_scan_fs( $self->dirs ) );
34              
35 11         3315 $self->_load_backend;
36 10         42 return $self->_init; # initialize the backend
37             }
38              
39             sub _process_events {
40 48     48   102 my ( $self, @raw_events ) = @_;
41              
42             # Some implementations provided enough information to parse the raw events,
43             # other require rescanning the file system (ie, Mac::FSEvents).
44             # The original behaviour was for rescan for all implementations, so we
45             # have added a flag to avoid breaking old code.
46              
47 48         49 my @events;
48              
49 48 100 66     1434 if ( $self->parse_events and $self->can('_parse_events') ) {
50 15         581 @events = $self->_apply_filter( $self->_parse_events(@raw_events) );
51             } else {
52 33         2949 my $new_fs = $self->_scan_fs( $self->dirs );
53 33         883 @events =
54             $self->_apply_filter( $self->_diff_fs( $self->_old_fs, $new_fs ) );
55 33         459 $self->_old_fs($new_fs);
56             }
57              
58             # Some backends need to add files (KQueue) or directories (Inotify2) to the
59             # watch list after they are created. Give them a chance to do that here.
60 48 100       888 $self->_add_created(@events) if $self->can('_add_created');
61              
62 48 100       607 $self->cb->(@events) if @events;
63              
64 48         3624 return \@events;
65             }
66              
67             sub _apply_filter {
68 48     48   64 my ( $self, @events ) = @_;
69              
70 48 100       704 if ( ref $self->filter eq 'CODE' ) {
    100          
71 40         2532 my $cb = $self->filter;
72 40         146 @events = grep { $cb->( $_->path ) } @events;
  50         237  
73             } elsif ( ref $self->filter eq 'Regexp' ) {
74 6         193 my $re = $self->filter;
75 6         23 @events = grep { $_->path =~ $re } @events;
  8         37  
76             }
77              
78 48         773 return @events;
79             }
80              
81             # Return a hash ref representing all the files and stats in @path.
82             # Keys are absolute path and values are path/mtime/size/is_dir
83             # Takes either array or arrayref
84             sub _scan_fs {
85 53     53   14193 my ( $self, @args ) = @_;
86              
87             # Accept either an array of dirs or a array ref of dirs
88 53 100       172 my @paths = ref $args[0] eq 'ARRAY' ? @{ $args[0] } : @args;
  45         117  
89              
90 53         118 my $fs_stats = {};
91              
92 53         372 my $rule = Path::Iterator::Rule->new;
93 53         429 my $next = $rule->iter(@paths);
94 53         4888 while ( my $file = $next->() ) {
95 500 100       25817 my $stat = $self->_stat($file)
96             or next; # Skip files that we can't stat (ie, broken symlinks on ext4)
97 498         10218 $fs_stats->{ abs_path($file) } = $stat;
98             }
99              
100 53         1335 return $fs_stats;
101             }
102              
103             sub _diff_fs {
104 40     40   562 my ( $self, $old_fs, $new_fs ) = @_;
105 40         48 my @events = ();
106              
107 40         140 for my $path ( keys %$old_fs ) {
108 353 100       1897 if ( not exists $new_fs->{$path} ) {
    100          
109             push @events,
110             AnyEvent::Filesys::Notify::Event->new(
111             path => $path,
112             type => 'deleted',
113             is_dir => $old_fs->{$path}->{is_dir},
114 13         331 );
115             } elsif (
116             $self->_is_path_modified( $old_fs->{$path}, $new_fs->{$path} ) )
117             {
118             push @events,
119             AnyEvent::Filesys::Notify::Event->new(
120             path => $path,
121             type => 'modified',
122             is_dir => $old_fs->{$path}->{is_dir},
123 14         311 );
124             }
125             }
126              
127 40         218 for my $path ( keys %$new_fs ) {
128 375 100       6537 if ( not exists $old_fs->{$path} ) {
129             push @events,
130             AnyEvent::Filesys::Notify::Event->new(
131             path => $path,
132             type => 'created',
133             is_dir => $new_fs->{$path}->{is_dir},
134 35         601 );
135             }
136             }
137              
138 40         3653 return @events;
139             }
140              
141             sub _is_path_modified {
142 340     340   257 my ( $self, $old_path, $new_path ) = @_;
143              
144 340 100       493 return 1 if $new_path->{mode} != $old_path->{mode};
145 332 100       521 return if $new_path->{is_dir};
146 195 100       262 return 1 if $new_path->{mtime} != $old_path->{mtime};
147 194 100       251 return 1 if $new_path->{size} != $old_path->{size};
148 189         281 return;
149             }
150              
151             # Originally taken from Filesys::Notify::Simple --Thanks Miyagawa
152             sub _stat {
153 500     500   504 my ( $self, $path ) = @_;
154              
155 500         3801 my @stat = stat $path;
156              
157             # Return undefined if no stats can be retrieved, as it happens with broken
158             # symlinks (at least under ext4).
159 500 100       927 return undef unless @stat;
160              
161             return {
162 498         2054 path => $path,
163             mtime => $stat[9],
164             size => $stat[7],
165             mode => $stat[2],
166             is_dir => -d _,
167             };
168              
169             }
170              
171             # Figure out which backend to use:
172             # I would prefer this to be done at compile time not object build, but I also
173             # want the user to be able to force the Fallback role. Something like an
174             # import flag would be great, but Moose creates an import sub for us and
175             # I'm not sure how to cleanly do it. Maybe need to use traits, but the
176             # documentation suggests traits are for application of roles by object.
177             # This will work for now.
178             sub _load_backend {
179 11     11   17 my $self = shift;
180              
181 11 100       61 if ( $self->backend ) {
    100          
    50          
    0          
    0          
182              
183             # Use the AEFN::Role prefix unless the backend starts with a +
184 3         7 my $prefix = "${AEFN}::Role::";
185 3         5 my $backend = $self->backend;
186 3 100       13 $backend = $prefix . $backend unless $backend =~ s{^\+}{};
187              
188 3     3   120 try { Moo::Role->apply_roles_to_object( $self, $backend ); }
189             catch {
190 0     0   0 croak "Unable to load the specified backend ($backend). You may "
191             . "need to install Linux::INotify2, Mac::FSEvents or IO::KQueue:"
192             . "\n$_";
193             }
194 3         21 } elsif ( $self->no_external ) {
195 3         22 Moo::Role->apply_roles_to_object( $self, "${AEFN}::Role::Fallback" );
196             } elsif ( $^O eq 'linux' ) {
197             try {
198 5     5   238 Moo::Role->apply_roles_to_object( $self,
199             "${AEFN}::Role::Inotify2" );
200             }
201             catch {
202 1     1   643 croak "Unable to load the Linux plugin. You may want to install "
203             . "Linux::INotify2 or specify 'no_external' (but that is very "
204             . "inefficient):\n$_";
205             }
206 5         45 } elsif ( $^O eq 'darwin' ) {
207             try {
208 0     0   0 Moo::Role->apply_roles_to_object( $self,
209             "${AEFN}::Role::FSEvents" );
210             }
211             catch {
212 0     0   0 croak "Unable to load the Mac plugin. You may want to install "
213             . "Mac::FSEvents or specify 'no_external' (but that is very "
214             . "inefficient):\n$_";
215             }
216 0         0 } elsif ( $^O =~ /bsd/ ) {
217             try {
218 0     0   0 Moo::Role->apply_roles_to_object( $self, "${AEFN}::Role::KQueue" );
219             }
220             catch {
221 0     0   0 croak "Unable to load the BSD plugin. You may want to install "
222             . "IO::KQueue or specify 'no_external' (but that is very "
223             . "inefficient):\n$_";
224             }
225 0         0 } else {
226 0         0 Moo::Role->apply_roles_to_object( $self, "${AEFN}::Role::Fallback" );
227             }
228              
229 10         4149 return 1;
230             }
231              
232             1;
233              
234             __END__