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   538017 use Moo;
  11         102932  
  11         70  
6 11     11   15359 use Moo::Role ();
  11         63079  
  11         215  
7 11     11   4319 use MooX::late;
  11         162590  
  11         60  
8 11     11   5977 use namespace::autoclean;
  11         108845  
  11         35  
9 11     11   10028 use AnyEvent;
  11         42181  
  11         304  
10 11     11   5863 use Path::Iterator::Rule;
  11         87864  
  11         326  
11 11     11   59 use Cwd qw/abs_path/;
  11         11  
  11         492  
12 11     11   4569 use AnyEvent::Filesys::Notify::Event;
  11         30  
  11         394  
13 11     11   68 use Carp;
  11         18  
  11         597  
14 11     11   43 use Try::Tiny;
  11         12  
  11         11566  
15              
16             our $VERSION = '1.21';
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 53939 my $self = shift;
32              
33 11         55 $self->_old_fs( $self->_scan_fs( $self->dirs ) );
34              
35 11         3955 $self->_load_backend;
36 10         44 return $self->_init; # initialize the backend
37             }
38              
39             sub _process_events {
40 48     48   97 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         57 my @events;
48              
49 48 100 66     1239 if ( $self->parse_events and $self->can('_parse_events') ) {
50 15         602 @events = $self->_apply_filter( $self->_parse_events(@raw_events) );
51             } else {
52 33         2949 my $new_fs = $self->_scan_fs( $self->dirs );
53 33         808 @events =
54             $self->_apply_filter( $self->_diff_fs( $self->_old_fs, $new_fs ) );
55 33         461 $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       916 $self->_process_events_for_backend(@events)
61             if $self->can('_process_events_for_backend');
62              
63 48 100       686 $self->cb->(@events) if @events;
64              
65 48         3724 return \@events;
66             }
67              
68             sub _apply_filter {
69 48     48   64 my ( $self, @events ) = @_;
70              
71 48 100       745 if ( ref $self->filter eq 'CODE' ) {
    100          
72 40         2532 my $cb = $self->filter;
73 40         148 @events = grep { $cb->( $_->path ) } @events;
  50         250  
74             } elsif ( ref $self->filter eq 'Regexp' ) {
75 6         201 my $re = $self->filter;
76 6         26 @events = grep { $_->path =~ $re } @events;
  8         35  
77             }
78              
79 48         781 return @events;
80             }
81              
82             # Return a hash ref representing all the files and stats in @path.
83             # Keys are absolute path and values are path/mtime/size/is_dir
84             # Takes either array or arrayref
85             sub _scan_fs {
86 53     53   14425 my ( $self, @args ) = @_;
87              
88             # Accept either an array of dirs or a array ref of dirs
89 53 100       163 my @paths = ref $args[0] eq 'ARRAY' ? @{ $args[0] } : @args;
  45         123  
90              
91 53         109 my $fs_stats = {};
92              
93 53         397 my $rule = Path::Iterator::Rule->new;
94 53         446 my $next = $rule->iter(@paths);
95 53         4856 while ( my $file = $next->() ) {
96 500 100       24228 my $stat = $self->_stat($file)
97             or next; # Skip files that we can't stat (ie, broken symlinks on ext4)
98 498         10207 $fs_stats->{ abs_path($file) } = $stat;
99             }
100              
101 53         1349 return $fs_stats;
102             }
103              
104             sub _diff_fs {
105 40     40   531 my ( $self, $old_fs, $new_fs ) = @_;
106 40         62 my @events = ();
107              
108 40         138 for my $path ( keys %$old_fs ) {
109 353 100       1808 if ( not exists $new_fs->{$path} ) {
    100          
110             push @events,
111             AnyEvent::Filesys::Notify::Event->new(
112             path => $path,
113             type => 'deleted',
114             is_dir => $old_fs->{$path}->{is_dir},
115 13         267 );
116             } elsif (
117             $self->_is_path_modified( $old_fs->{$path}, $new_fs->{$path} ) )
118             {
119             push @events,
120             AnyEvent::Filesys::Notify::Event->new(
121             path => $path,
122             type => 'modified',
123             is_dir => $old_fs->{$path}->{is_dir},
124 14         295 );
125             }
126             }
127              
128 40         253 for my $path ( keys %$new_fs ) {
129 375 100       8870 if ( not exists $old_fs->{$path} ) {
130             push @events,
131             AnyEvent::Filesys::Notify::Event->new(
132             path => $path,
133             type => 'created',
134             is_dir => $new_fs->{$path}->{is_dir},
135 35         610 );
136             }
137             }
138              
139 40         1961 return @events;
140             }
141              
142             sub _is_path_modified {
143 340     340   268 my ( $self, $old_path, $new_path ) = @_;
144              
145 340 100       483 return 1 if $new_path->{mode} != $old_path->{mode};
146 332 100       517 return if $new_path->{is_dir};
147 195 100       254 return 1 if $new_path->{mtime} != $old_path->{mtime};
148 194 100       258 return 1 if $new_path->{size} != $old_path->{size};
149 189         275 return;
150             }
151              
152             # Originally taken from Filesys::Notify::Simple --Thanks Miyagawa
153             sub _stat {
154 500     500   474 my ( $self, $path ) = @_;
155              
156 500         3818 my @stat = stat $path;
157              
158             # Return undefined if no stats can be retrieved, as it happens with broken
159             # symlinks (at least under ext4).
160 500 100       880 return undef unless @stat;
161              
162             return {
163 498         2028 path => $path,
164             mtime => $stat[9],
165             size => $stat[7],
166             mode => $stat[2],
167             is_dir => -d _,
168             };
169              
170             }
171              
172             # Figure out which backend to use:
173             # I would prefer this to be done at compile time not object build, but I also
174             # want the user to be able to force the Fallback role. Something like an
175             # import flag would be great, but Moose creates an import sub for us and
176             # I'm not sure how to cleanly do it. Maybe need to use traits, but the
177             # documentation suggests traits are for application of roles by object.
178             # This will work for now.
179             sub _load_backend {
180 11     11   14 my $self = shift;
181              
182 11 100       64 if ( $self->backend ) {
    100          
    50          
    0          
    0          
183              
184             # Use the AEFN::Role prefix unless the backend starts with a +
185 3         8 my $prefix = "${AEFN}::Role::";
186 3         7 my $backend = $self->backend;
187 3 100       15 $backend = $prefix . $backend unless $backend =~ s{^\+}{};
188              
189 3     3   126 try { Moo::Role->apply_roles_to_object( $self, $backend ); }
190             catch {
191 0     0   0 croak "Unable to load the specified backend ($backend). You may "
192             . "need to install Linux::INotify2, Mac::FSEvents or IO::KQueue:"
193             . "\n$_";
194             }
195 3         24 } elsif ( $self->no_external ) {
196 3         24 Moo::Role->apply_roles_to_object( $self, "${AEFN}::Role::Fallback" );
197             } elsif ( $^O eq 'linux' ) {
198             try {
199 5     5   281 Moo::Role->apply_roles_to_object( $self,
200             "${AEFN}::Role::Inotify2" );
201             }
202             catch {
203 1     1   635 croak "Unable to load the Linux plugin. You may want to install "
204             . "Linux::INotify2 or specify 'no_external' (but that is very "
205             . "inefficient):\n$_";
206             }
207 5         47 } elsif ( $^O eq 'darwin' ) {
208             try {
209 0     0   0 Moo::Role->apply_roles_to_object( $self,
210             "${AEFN}::Role::FSEvents" );
211             }
212             catch {
213 0     0   0 croak "Unable to load the Mac plugin. You may want to install "
214             . "Mac::FSEvents or specify 'no_external' (but that is very "
215             . "inefficient):\n$_";
216             }
217 0         0 } elsif ( $^O =~ /bsd/ ) {
218             try {
219 0     0   0 Moo::Role->apply_roles_to_object( $self, "${AEFN}::Role::KQueue" );
220             }
221             catch {
222 0     0   0 croak "Unable to load the BSD plugin. You may want to install "
223             . "IO::KQueue or specify 'no_external' (but that is very "
224             . "inefficient):\n$_";
225             }
226 0         0 } else {
227 0         0 Moo::Role->apply_roles_to_object( $self, "${AEFN}::Role::Fallback" );
228             }
229              
230 10         4351 return 1;
231             }
232              
233             1;
234              
235             __END__