File Coverage

blib/lib/Filesys/Notify/Simple.pm
Criterion Covered Total %
statement 67 152 44.0
branch 13 30 43.3
condition 17 37 45.9
subroutine 14 22 63.6
pod 0 8 0.0
total 111 249 44.5


line stmt bran cond sub pod time code
1             package Filesys::Notify::Simple;
2              
3 6     6   61415 use strict;
  6         13  
  6         302  
4 6     6   161 use 5.008_001;
  6         20  
  6         299  
5             our $VERSION = '0.12';
6              
7 6     6   283 use Carp ();
  6         18  
  6         132  
8 6     6   32 use Cwd;
  6         12  
  6         523  
9 6     6   57 use constant NO_OPT => $ENV{PERL_FNS_NO_OPT};
  6         11  
  6         21796  
10              
11             sub new {
12 5     5 0 6611 my($class, $path) = @_;
13              
14 5 50       34 unless (ref $path eq 'ARRAY') {
15 0         0 Carp::croak('Usage: Filesys::Notify::Simple->new([ $path1, $path2 ])');
16             }
17              
18 5         23 my $self = bless { paths => $path }, $class;
19 5         25 $self->init;
20              
21 5         22 $self;
22             }
23              
24             sub wait {
25 5     5 0 32096 my($self, $cb) = @_;
26              
27 5   66     172 $self->{watcher} ||= $self->{watcher_cb}->(@{$self->{paths}});
  3         143  
28 5         19 $self->{watcher}->($cb);
29             }
30              
31             sub init {
32 5     5 0 12 my $self = shift;
33              
34 5         10 local $@;
35 5 50 50     105 if ($^O eq 'linux' && !NO_OPT && eval { require Linux::Inotify2; 1 }) {
  4 50 66     2504  
  0 50 50     0  
    50 33        
    50 50        
      33        
      50        
      33        
      50        
      33        
36 0         0 $self->{watcher_cb} = \&wait_inotify2;
37 0         0 } elsif ($^O eq 'darwin' && !NO_OPT && eval { require Mac::FSEvents; 1 }) {
  0         0  
38 0         0 $self->{watcher_cb} = \&wait_fsevents;
39 0         0 } elsif ($^O eq 'freebsd' && !NO_OPT && eval { require Filesys::Notify::KQueue; 1 }) {
  0         0  
40 0         0 $self->{watcher_cb} = \&wait_kqueue;
41 0         0 } elsif ($^O eq 'MSWin32' && !NO_OPT && eval { require Win32::ChangeNotify; 1 }) {
  0         0  
42 0         0 $self->{watcher_cb} = mk_wait_win32(0); # Not cygwin
43 0         0 } elsif ($^O eq 'cygwin' && !NO_OPT && eval { require Win32::ChangeNotify; 1 }) {
  0         0  
44 0         0 $self->{watcher_cb} = mk_wait_win32(1); # Cygwin
45             } else {
46 5         52 $self->{watcher_cb} = \&wait_timer;
47             }
48             }
49              
50             sub wait_inotify2 {
51 0     0 0 0 my @path = @_;
52              
53 0         0 Linux::Inotify2->import;
54 0         0 my $inotify = Linux::Inotify2->new;
55              
56 0         0 my $fs = _full_scan(@path);
57 0         0 for my $path (keys %$fs) {
58 0         0 $inotify->watch($path, &IN_MODIFY|&IN_CREATE|&IN_DELETE|&IN_DELETE_SELF|&IN_MOVE_SELF|&IN_MOVE);
59             }
60              
61             return sub {
62 0     0   0 my $cb = shift;
63 0         0 $inotify->blocking(1);
64 0         0 my @events = $inotify->read;
65 0         0 $cb->(map { +{ path => $_->fullname } } @events);
  0         0  
66 0         0 };
67             }
68              
69             sub wait_fsevents {
70 0     0 0 0 require IO::Select;
71 0         0 my @path = @_;
72              
73 0         0 my $fs = _full_scan(@path);
74 0         0 my $sel = IO::Select->new;
75              
76 0         0 my %events;
77 0         0 for my $path (@path) {
78 0         0 my $fsevents = Mac::FSEvents->new({ path => $path, latency => 1 });
79 0         0 my $fh = $fsevents->watch;
80 0         0 $sel->add($fh);
81 0         0 $events{fileno $fh} = $fsevents;
82             }
83              
84             return sub {
85 0     0   0 my $cb = shift;
86              
87 0         0 my @ready = $sel->can_read;
88 0         0 my @events;
89 0         0 for my $fh (@ready) {
90 0         0 my $fsevents = $events{fileno $fh};
91 0         0 my %uniq;
92 0         0 my @path = grep !$uniq{$_}++, map { $_->path } $fsevents->read_events;
  0         0  
93              
94 0         0 my $new_fs = _full_scan(@path);
95 0         0 my $old_fs = +{ map { ($_ => $fs->{$_}) } keys %$new_fs };
  0         0  
96 0         0 _compare_fs($old_fs, $new_fs, sub { push @events, { path => $_[0] } });
  0         0  
97 0         0 $fs->{$_} = $new_fs->{$_} for keys %$new_fs;
98 0 0       0 last if @events;
99             }
100              
101 0         0 $cb->(@events);
102 0         0 };
103             }
104              
105             sub wait_kqueue {
106 0     0 0 0 my @path = @_;
107              
108 0         0 my $kqueue = Filesys::Notify::KQueue->new(
109             path => \@path
110             );
111              
112 0     0   0 return sub { $kqueue->wait(shift) };
  0         0  
113             }
114              
115             sub mk_wait_win32 {
116 0     0 0 0 my ($is_cygwin) = @_;
117              
118             return sub {
119 0     0   0 my @path = @_;
120              
121 0         0 my $fs = _full_scan(@path);
122 0         0 my (@notify, @fskey);
123 0         0 for my $path (keys %$fs) {
124 0 0       0 my $winpath = $is_cygwin ? Cygwin::posix_to_win_path($path) : $path;
125             # 0x1b means 'DIR_NAME|FILE_NAME|LAST_WRITE|SIZE' = 2|1|0x10|8
126 0         0 push @notify, Win32::ChangeNotify->new($winpath, 0, 0x1b);
127 0         0 push @fskey, $path;
128             }
129              
130             return sub {
131 0         0 my $cb = shift;
132              
133 0         0 my @events;
134 0         0 while(1) {
135 0         0 my $idx = Win32::ChangeNotify::wait_any(\@notify);
136 0 0       0 Carp::croak("Can't wait notifications, maybe ".scalar(@notify)." directories exceeds limitation.") if ! defined $idx;
137 0 0       0 if($idx > 0) {
138 0         0 --$idx;
139 0         0 my $new_fs = _full_scan($fskey[$idx]);
140 0         0 $notify[$idx]->reset;
141 0         0 my $old_fs = +{ map { ($_ => $fs->{$_}) } keys %$new_fs };
  0         0  
142 0         0 _compare_fs($old_fs, $new_fs, sub { push @events, { path => $_[0] } });
  0         0  
143 0         0 $fs->{$_} = $new_fs->{$_} for keys %$new_fs;
144 0 0       0 last if @events; # Actually changed
145             }
146             }
147 0         0 $cb->(@events);
148             }
149 0         0 }
150 0         0 }
151              
152             sub wait_timer {
153 3     3 0 73 my @path = @_;
154              
155 3         92 my $fs = _full_scan(@path);
156              
157             return sub {
158 5     5   13 my $cb = shift;
159 5         8 my @events;
160 5         17 while (1) {
161 7         13001844 sleep 2;
162 7         173 my $new_fs = _full_scan(@path);
163 6         119 _compare_fs($fs, $new_fs, sub { push @events, { path => $_[0] } });
  5         30  
164 6         22 $fs = $new_fs;
165 6 100       51 last if @events;
166             };
167 4         22 $cb->(@events);
168 3         49 };
169             }
170              
171             sub _compare_fs {
172 6     6   14 my($old, $new, $cb) = @_;
173              
174 6         31 for my $dir (keys %$old) {
175 24         33 for my $path (keys %{$old->{$dir}}) {
  24         70  
176 20 100 33     1069 if (!exists $new->{$dir}{$path}) {
    50 66        
177 2         14 $cb->($path); # deleted
178             } elsif (!$new->{$dir}{$path}{is_dir} &&
179             ( $old->{$dir}{$path}{mtime} != $new->{$dir}{$path}{mtime} ||
180             $old->{$dir}{$path}{size} != $new->{$dir}{$path}{size})) {
181 0         0 $cb->($path); # updated
182             }
183             }
184             }
185              
186 6         20 for my $dir (keys %$new) {
187 24         33 for my $path (sort grep { !exists $old->{$dir}{$_} } keys %{$new->{$dir}}) {
  21         85  
  24         64  
188 3         109 $cb->($path); # new
189             }
190             }
191             }
192              
193             sub _full_scan {
194 9     9   60 my @paths = @_;
195 9         284 require File::Find;
196              
197 9         34 my %map;
198 9         59 for my $path (@paths) {
199 17 100       53 my $fp = eval { Cwd::realpath($path) } or next;
  17         4371  
200             File::Find::finddepth({
201             wanted => sub {
202 43   33 43   137 my $fullname = $File::Find::fullname || File::Spec->rel2abs($File::Find::name);
203 43         139 $map{Cwd::realpath($File::Find::dir)}{$fullname} = _stat($fullname);
204             },
205 16         11783 follow_fast => 1,
206             follow_skip => 2,
207             no_chdir => 1,
208             }, $path);
209              
210             # remove root entry
211             # NOTE: On MSWin32, realpath and rel2abs disagree with path separator.
212 16         676 delete $map{$fp}{File::Spec->rel2abs($fp)};
213             }
214              
215 9         31 return \%map;
216             }
217              
218             sub _stat {
219 43     43   62 my $path = shift;
220 43         945 my @stat = stat $path;
221 43         10007 return { path => $path, mtime => $stat[9], size => $stat[7], is_dir => -d _ };
222             }
223              
224              
225             1;
226             __END__
227              
228             =encoding utf-8
229              
230             =for stopwords
231              
232             =head1 NAME
233              
234             Filesys::Notify::Simple - Simple and dumb file system watcher
235              
236             =head1 SYNOPSIS
237              
238             use Filesys::Notify::Simple;
239              
240             my $watcher = Filesys::Notify::Simple->new([ "." ]);
241             $watcher->wait(sub {
242             for my $event (@_) {
243             $event->{path} # full path of the file updated
244             }
245             });
246              
247             =head1 DESCRIPTION
248              
249             Filesys::Notify::Simple is a simple but unified interface to get
250             notifications of changes to a given filesystem path. It utilizes
251             inotify2 on Linux, fsevents on OS X, kqueue on FreeBSD and
252             FindFirstChangeNotification on Windows if they're installed, with a
253             fallback to the full directory scan if they're not available.
254              
255             There are some limitations in this module. If you don't like it, use
256             L<File::ChangeNotify>.
257              
258             =over 4
259              
260             =item *
261              
262             There is no file name based filter. Do it in your own code.
263              
264             =item *
265              
266             You can not get types of events (created, updated, deleted).
267              
268             =item *
269              
270             Currently C<wait> method blocks.
271              
272             =back
273              
274             In return, this module doesn't depend on any non-core
275             modules. Platform specific optimizations with L<Linux::Inotify2>,
276             L<Mac::FSEvents>, L<Filesys::Notify::KQueue> and L<Win32::ChangeNotify>
277             are truely optional.
278              
279             NOTE: Using L<Win32::ChangeNotify> may put additional limitations.
280              
281             =over 4
282              
283             =item *
284              
285             L<Win32::ChangeNotify> uses FindFirstChangeNotificationA so that
286             Unicode characters can not be handled.
287             On cygwin (1.7 or later), Unicode characters should be able to be handled
288             when L<Win32::ChangeNotify> is not used.
289              
290             =item *
291              
292             If more than 64 directories are included under the specified paths,
293             an error occurrs.
294              
295             =back
296              
297             =head1 AUTHOR
298              
299             Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
300              
301             =head1 LICENSE
302              
303             This library is free software; you can redistribute it and/or modify
304             it under the same terms as Perl itself.
305              
306             =head1 SEE ALSO
307              
308             L<File::ChangeNotify> L<Mac::FSEvents> L<Linux::Inotify2> L<Filesys::Notify::KQueue>
309             L<Win32::ChangeNotify>
310              
311             =cut