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__ |