File Coverage

blib/lib/File/ChangeNotify/Watcher/KQueue.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package File::ChangeNotify::Watcher::KQueue;
2              
3 2     2   874 use strict;
  2         4  
  2         53  
4 2     2   10 use warnings;
  2         4  
  2         44  
5 2     2   8 use namespace::autoclean;
  2         6  
  2         8  
6              
7             our $VERSION = '0.30';
8              
9 2     2   156 use File::Find qw( find );
  2         4  
  2         115  
10 2     2   169 use IO::KQueue;
  0            
  0            
11             use Types::Standard qw( HashRef Int );
12             use Type::Utils qw( class_type );
13              
14             use Moo;
15              
16             has absorb_delay => (
17             is => 'ro',
18             isa => Int,
19             default => 100,
20             );
21              
22             has _kqueue => (
23             is => 'ro',
24             isa => class_type('IO::KQueue'),
25             default => sub { IO::KQueue->new },
26             init_arg => undef,
27             );
28              
29             # We need to keep hold of filehandles for all the directories *and* files in the
30             # tree. KQueue events will be automatically deleted when the filehandles go out
31             # of scope.
32             has _files => (
33             is => 'ro',
34             isa => HashRef,
35             default => sub { {} },
36             init_arg => undef,
37             );
38              
39             with 'File::ChangeNotify::Watcher';
40              
41             sub sees_all_events {0}
42              
43             sub BUILD {
44             my $self = shift;
45              
46             $self->_watch_dir($_) for @{ $self->directories };
47              
48             $self->_set_map( $self->_current_map )
49             if $self->modify_includes_file_attributes
50             || $self->modify_includes_content;
51              
52             return;
53             }
54              
55             sub wait_for_events {
56             my $self = shift;
57              
58             while (1) {
59             my @events = $self->_interesting_events;
60             return @events if @events;
61             }
62             }
63              
64             around new_events => sub {
65             my $orig = shift;
66             my $self = shift;
67              
68             return $self->$orig(0);
69             };
70              
71             sub _interesting_events {
72             my $self = shift;
73             my $timeout = shift;
74              
75             my @kevents = $self->_kqueue->kevent( defined $timeout ? $timeout : () );
76              
77             # Events come in groups, wait for a short period to absorb any extra ones
78             # that might happen immediately after the ones we've detected.
79             push @kevents, $self->_kqueue->kevent( $self->absorb_delay )
80             if $self->absorb_delay;
81              
82             my ( $old_map, $new_map );
83             if ( $self->modify_includes_file_attributes
84             || $self->modify_includes_content ) {
85             $old_map = $self->_map;
86             $new_map = $self->_current_map;
87             }
88              
89             my @events;
90             for my $kevent (@kevents) {
91             my $path = $kevent->[KQ_UDATA];
92             next if $self->_path_is_excluded($path);
93              
94             my $flags = $kevent->[KQ_FFLAGS];
95              
96             ## no critic (ControlStructures::ProhibitCascadingIfElse)
97              
98             # Delete - this works reasonably well with KQueue
99             if ( $flags & NOTE_DELETE ) {
100             delete $self->_files->{$path};
101             push @events, $self->_event( $path, 'delete' );
102             }
103              
104             # Rename - represented as deletes and creates
105             elsif ( $flags & NOTE_RENAME ) {
106              
107             # Renamed dirs
108             # Use the stored filehandle (it survives renaming) to identify a dir
109             # and remove any filehandles we're storing to its contents
110             my $fh = $self->_files->{$path};
111             if ( -d $fh ) {
112             for my $stored_path ( keys %{ $self->_files } ) {
113             next unless index( $stored_path, $path ) == 0;
114             delete $self->_files->{$stored_path};
115             push @events, $self->_event( $stored_path, 'delete' );
116             }
117             }
118              
119             # Renamed files
120             else {
121             delete $self->_files->{$path};
122             push @events, $self->_event( $path, 'delete' );
123             }
124             }
125              
126             # Modify/Create - writes to files indicate modification, but we get
127             # writes to dirs too, which indicates a file (or dir) was created or
128             # removed from the dir. Deletes are picked up by delete events, but to
129             # find created files we have to scan the dir again.
130             elsif ( $flags & NOTE_WRITE ) {
131              
132             if ( -f $path ) {
133             push @events,
134             $self->_event( $path, 'modify', $old_map, $new_map );
135             }
136             elsif ( -d $path ) {
137             push @events,
138             map { $self->_event( $_, 'create' ) }
139             $self->_watch_dir($path);
140             }
141             }
142             elsif ( $flags & NOTE_ATTRIB ) {
143             push @events,
144             $self->_event( $path, 'modify', $old_map, $new_map );
145             }
146             }
147              
148             $self->_set_map($new_map)
149             if $self->_has_map;
150              
151             return @events;
152             }
153              
154             sub _event {
155             my $self = shift;
156             my $path = shift;
157             my $type = shift;
158             my $old_map = shift;
159             my $new_map = shift;
160              
161             my @extra;
162             if (
163             $type eq 'modify'
164             && ( $self->modify_includes_file_attributes
165             || $self->modify_includes_content )
166             ) {
167              
168             @extra = (
169             $self->_modify_event_maybe_file_attribute_changes(
170             $path, $old_map, $new_map
171             ),
172             $self->_modify_event_maybe_content_changes(
173             $path, $old_map, $new_map
174             ),
175             );
176             }
177              
178             return $self->event_class->new(
179             path => $path,
180             type => $type,
181             @extra,
182             );
183             }
184              
185             sub _watch_dir {
186             my $self = shift;
187             my $dir = shift;
188              
189             my @new_files;
190              
191             # use find(), finddepth() doesn't support pruning
192             $self->_find(
193             $dir,
194             sub {
195             my $path = $File::Find::name;
196              
197             # Don't monitor anything below excluded dirs
198             return $File::Find::prune = 1
199             if $self->_path_is_excluded($path);
200              
201             # Skip file names that don't match the filter
202             return unless $self->_is_included_file($path);
203              
204             # Skip if we're watching it already
205             return if $self->_files->{$path};
206              
207             $self->_watch_path($path);
208             push @new_files, $path;
209             }
210             );
211              
212             return @new_files;
213             }
214              
215             sub _is_included_file {
216             my $self = shift;
217             my $path = shift;
218              
219             return 1 if -d $path;
220              
221             my $filter = $self->filter;
222             my $filename = ( File::Spec->splitpath($path) )[2];
223              
224             return 1 if $filename =~ m{$filter};
225             return 0;
226             }
227              
228             sub _find {
229             my $self = shift;
230             my $dir = shift;
231             my $wanted = shift;
232              
233             find(
234             {
235             wanted => $wanted,
236             no_chdir => 1,
237             follow_fast => ( $self->follow_symlinks ? 1 : 0 ),
238             follow_skip => 2,
239             },
240             $dir,
241             );
242             }
243              
244             sub _watch_path {
245             my $self = shift;
246             my $path = shift;
247              
248             ## no critic (InputOutput::RequireBriefOpen)
249              
250             # Don't panic if we can't open a file
251             open my $fh, '<', $path or warn "Can't open '$path': $!";
252             return unless $fh && defined fileno $fh;
253              
254             # Store this filehandle (this will automatically nuke any existing events
255             # assigned to the file)
256             $self->_files->{$path} = $fh;
257              
258             my $filter = NOTE_DELETE | NOTE_WRITE | NOTE_RENAME | NOTE_REVOKE;
259             $filter |= NOTE_ATTRIB
260             if $self->_path_matches(
261             $self->modify_includes_file_attributes,
262             $path
263             );
264              
265             $self->_kqueue->EV_SET(
266             fileno($fh),
267             EVFILT_VNODE,
268             EV_ADD | EV_CLEAR,
269             $filter,
270             0,
271             $path,
272             );
273             }
274              
275             __PACKAGE__->meta->make_immutable;
276              
277             1;
278              
279             __END__