File Coverage

blib/lib/File/Monitor/Object.pm
Criterion Covered Total %
statement 97 98 98.9
branch 24 28 85.7
condition 3 3 100.0
subroutine 19 19 100.0
pod 3 4 75.0
total 146 152 96.0


line stmt bran cond sub pod time code
1             package File::Monitor::Object;
2              
3 6     6   301 use strict;
  6         12  
  6         183  
4 6     6   28 use warnings;
  6         8  
  6         202  
5 6     6   28 use Carp;
  6         15  
  6         325  
6 6     6   58 use File::Spec;
  6         15  
  6         148  
7 6     6   38 use Scalar::Util qw(weaken);
  6         10  
  6         817  
8 6     6   31 use Fcntl ':mode';
  6         9  
  6         2511  
9              
10 6     6   4044 use File::Monitor::Delta;
  6         21  
  6         325  
11              
12 6     6   55 use base qw(File::Monitor::Base);
  6         21  
  6         1536  
13              
14             our $VERSION = '1.00';
15              
16             my @STAT_FIELDS;
17             my @INFO_FIELDS;
18             my $CLASS;
19              
20             BEGIN {
21              
22 6     6   25 @STAT_FIELDS = qw(
23             dev inode mode num_links uid gid rdev size atime mtime ctime
24             blk_size blocks
25             );
26              
27 6         30 @INFO_FIELDS = (
28             @STAT_FIELDS, qw(
29             error
30             )
31             );
32              
33 6     6   35 no strict 'refs';
  6         11  
  6         758  
34              
35             # Accessors for info
36 6         16 for my $info ( @INFO_FIELDS ) {
37             *$info = sub {
38 28     28   16205 my $self = shift;
39 28 100       2090 croak "$info attribute is read-only" if @_;
40 14         46 return $self->{_info}->{$info};
41 84         34399 };
42             }
43             }
44              
45             sub owner {
46 968     968 0 1302 my $self = shift;
47 968 50       2317 croak "name attribute is read-only" if @_;
48 968         4370 return $self->{owner};
49             }
50              
51             sub name {
52 850     850 1 3756 my $self = shift;
53 850 100       2604 croak "name attribute is read-only" if @_;
54 846         1643 return $self->owner->_make_absolute( $self->{name} );
55             }
56              
57             sub files {
58 2     2 1 1014 my $self = shift;
59 2 100       127 croak "files attribute is read-only" if @_;
60 1         6 my $monitor = $self->owner;
61             return
62 0 50       0 map { $monitor->_make_absolute( $_ ) }
  1         11  
63 1         3 @{ $self->{_info}->{files} || [] };
64             }
65              
66             sub _initialize {
67 28     28   44 my $self = shift;
68 28         42 my $args = shift;
69              
70             # Normalize the args
71              
72 28         111 $self->SUPER::_initialize( $args );
73 28         97 $self->_install_callbacks( $args );
74              
75 28         146 $self->{_info}->{virgin} = 1;
76              
77 28 100       461 my $name = delete $args->{name}
78             or croak "The name option must be supplied";
79              
80 27 100       396 $self->{owner} = delete $args->{owner}
81             or croak "A " . __PACKAGE__ . " must have an owner";
82              
83             # Build our object
84 26         76 $self->{name} = $self->owner->_canonical_name( $name );
85              
86             # Avoid circular references
87 26         112 weaken $self->{owner};
88              
89 26         47 for my $opt ( qw(files recurse) ) {
90 52         192 $self->{_options}->{$opt} = delete $args->{$opt};
91             }
92              
93 26         208 $self->_report_extra( $args );
94             }
95              
96             sub _read_dir {
97 184     184   245 my $self = shift;
98 184         240 my $dir = shift;
99              
100 184 50       5476 opendir( my $dh, $dir ) or die "Can't read $dir ($!)";
101 190         20225 my @files = map { File::Spec->catfile( $dir, $_ ) }
  558         1901  
102             sort
103 184         2768 grep { $_ !~ /^[.]{1,2}$/ } readdir( $dh );
104 184         1984 closedir( $dh );
105              
106 184         1148 return @files;
107             }
108              
109             sub _stat {
110 352     352   493 my $self = shift;
111 352         443 my $name = shift;
112              
113 352         10722 return stat $name;
114             }
115              
116             # Scan our target object
117             sub _scan_object {
118 352     352   499 my $self = shift;
119 352         642 my $name = $self->name;
120 352         544 my %info;
121              
122 352         500 eval {
123 352         726 @info{@STAT_FIELDS} = $self->_stat( $name );
124              
125 352 100 100     2455 if ( defined $info{mode} && S_ISDIR( $info{mode} ) ) {
126 50         136 my $monitor = $self->owner;
127              
128             # Do directory specific things
129 50 100       251 if ( $self->{_options}->{files} ) {
    50          
130              
131             # Expand one level
132 24         75 $info{files} = [ map { $monitor->_make_relative( $_ ) }
  20         85  
133             $self->_read_dir( $name ) ];
134             }
135             elsif ( $self->{_options}->{recurse} ) {
136              
137             # Expand whole directory tree
138 26         90 my @work = $self->_read_dir( $name );
139 26         111 while ( my $obj = shift @work ) {
140 170         217 push @{ $info{files} }, $monitor->_make_relative( $obj );
  170         663  
141 170 100       3891 if ( -d $obj ) {
142              
143             # Depth first to simulate recursion
144 134         296 unshift @work, $self->_read_dir( $obj );
145             }
146             }
147             }
148             }
149             };
150              
151 352         981 $info{error} = $@;
152              
153 352         765 return \%info;
154             }
155              
156             sub scan {
157 352     352 1 520 my $self = shift;
158              
159 352         656 my $info = $self->_scan_object;
160 352         712 my $name = $self->name;
161 352         697 my @changes = ();
162              
163 352 100       1239 unless ( delete $self->{_info}->{virgin} ) {
164              
165             # Already done one scan, so now we compute deltas
166 330         2028 my $change = File::Monitor::Delta->new(
167             {
168             object => $self,
169             old_info => $self->{_info},
170             new_info => $info
171             }
172             );
173              
174 330 100       1533 if ( $change->is_change ) {
175 42         177 $self->_make_callbacks( $change );
176 42         247 push @changes, $change;
177             }
178             }
179              
180 352         611 $self->{_info} = $info;
181              
182 352         1774 return @changes;
183             }
184              
185             1;
186              
187             =head1 NAME
188              
189             File::Monitor::Object - Monitor a filesystem object for changes.
190              
191             =head1 VERSION
192              
193             This document describes File::Monitor::Object version 1.00
194              
195             =head1 SYNOPSIS
196              
197             Created by L to monitor a single file or directory.
198              
199             use File::Monitor;
200             use File::Monitor::Object;
201              
202             my $monitor = File::Monitor->new();
203              
204             for my $file ( @files ) {
205             $monitor->watch( $file );
206             }
207              
208             # First scan just finds out about the monitored files. No changes
209             # will be reported.
210             $monitor->scan;
211              
212             # Later perform a scan and gather any changes
213             for my $change ( $monitor->scan ) {
214             # $change is a File::Monitor::Delta
215             }
216              
217             =head1 DESCRIPTION
218              
219             Monitors changes to a single file or directory. Don't create a
220             C directly; instead call C on
221             L.
222              
223             A C represents a single file or directory. The
224             corresponding file or directory need not exist; a file being created is
225             one of the events that is monitored for. Similarly if the file or directory
226             is deleted that will be reported as a change.
227              
228             Changes of state are returned as a L object.
229              
230             The state of the monitored file or directory at the time of the last
231             C can be queried. Before C is called these methods will all
232             return C. The following methods return the value of the
233             corresponding field from L:
234              
235             dev inode mode num_links uid gid rdev size
236             atime mtime ctime blk_size blocks
237              
238             For example:
239              
240             my $file_size = $object->size;
241             my $modified = $object->mtime;
242              
243             If any error occured during the previous C it may be retrieved like this:
244              
245             my $last_error = $obj->error;
246              
247             It is not an error for the file being monitored not to exist.
248              
249             Finally if a directory is being monitored and the C or C
250             option was specified the list of files in the directory may be retrieved
251             like this:
252              
253             my @contained_files = $obj->files;
254              
255             If C was specified this will return the files and directories
256             immediately below the monitored directory but not the contents of any
257             subdirectories. If C was specified the entire directory tree
258             below this directory will be returned.
259              
260             In either case the returned filenames will be complete absolute paths.
261              
262             =head2 Caveat for Directories
263              
264             Note that C has no magical way to quickly perform
265             a recursive scan of a directory. If you point it at a directory
266             containing 1,000,000 files and specify the C option directory
267             scans I take a long time.
268              
269             =head1 INTERFACE
270              
271             =over
272              
273             =item C<< new( $args ) >>
274              
275             Create a new C. Don't call C directly; use
276             instead L<< File::Monitor->watch >>.
277              
278             =item C<< scan() >>
279              
280             Perform a scan of the monitored file or directory and return a list
281             of changes. The returned list will contain either a single
282             L object describing all changes or will be empty
283             if no changes occurred.
284              
285             if ( my $change = $object->scan ) {
286             # $change is a File::Monitor::Delta that describes all the
287             # changes to the monitored file or directory.
288             }
289              
290             When C is first called the current state of the monitored
291             file/directory will be captured but no change will be reported.
292              
293             =item C<< callback( [ $event, ] $coderef ) >>
294              
295             Register a callback. If C<$event> is omitted the callback will be called
296             for all changes. Specify C<$event> to limit the callback to certain event
297             types. See L for a full list of events.
298              
299             $object->callback( sub {
300             # called for all changes
301             } );
302              
303             $object->callback( metadata => sub {
304             # called for changes to file/directory metatdata
305             } );
306              
307             See L for a full list of events that can be
308             monitored.
309              
310             =item C<< name >>
311              
312             Returns the absolute name of the file or directory being monitored. If
313             C was passed a relative path it is resolved relative to the current
314             directory at the time of object creation to make it absolute.
315              
316             =item C<< files >>
317              
318             If monitoring a directory and the C or C options were
319             specified to C, C returns a list of contained files. The
320             returned filenames will be absolute paths.
321              
322             =back
323              
324             =head2 Other Accessors
325              
326             In addition to the above the following methods may be called to return
327             the value of the corresponding field from L:
328              
329             dev inode mode num_links uid gid rdev size
330             atime mtime ctime blk_size blocks
331              
332             For example:
333              
334             my $inode = $obj->inode;
335              
336             Check the documentation for L to discover which fields
337             are valid on your platform.
338              
339             =head1 DIAGNOSTICS
340              
341             =over
342              
343             =item C<< %s is read-only >>
344              
345             You have attempted to modify a read-only accessor. It may be tempting
346             for example to attempt to change the name of the monitored file or
347             directory like this:
348              
349             # Won't work
350             $obj->name( 'somefile.txt' );
351              
352             All of the attributes exposed by C are read-only.
353              
354             =item C<< When options are supplied as a hash there may be no other arguments >>
355              
356             When creating a new C you must either supply
357             C with a reference to a hash of options or, as a special case, pass
358             a filename and optionally a callback.
359              
360             =item C<< The name option must be supplied >>
361              
362             The options hash must contain a key called C that specifies the
363             name of the file or directory to be monitored.
364              
365             =item C<< A filename must be specified >>
366              
367             You must suppy C with the name of the file or directory to be
368             monitored.
369              
370             =back
371              
372             =head1 CONFIGURATION AND ENVIRONMENT
373              
374             File::Monitor::Object requires no configuration files or environment variables.
375              
376             =head1 DEPENDENCIES
377              
378             None.
379              
380             =head1 INCOMPATIBILITIES
381              
382             None reported.
383              
384             =head1 BUGS AND LIMITATIONS
385              
386             No bugs have been reported.
387              
388             Please report any bugs or feature requests to
389             C, or through the web interface at
390             L.
391              
392             =head1 AUTHOR
393              
394             Andy Armstrong C<< >>
395              
396             Faycal Chraibi originally registered the File::Monitor namespace and
397             then kindly handed it to me.
398              
399             =head1 LICENCE AND COPYRIGHT
400              
401             Copyright (c) 2007, Andy Armstrong C<< >>. All rights reserved.
402              
403             This module is free software; you can redistribute it and/or
404             modify it under the same terms as Perl itself. See L.
405              
406             =head1 DISCLAIMER OF WARRANTY
407              
408             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
409             FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
410             OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
411             PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
412             EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
413             WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
414             ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
415             YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
416             NECESSARY SERVICING, REPAIR, OR CORRECTION.
417              
418             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
419             WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
420             REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
421             LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
422             OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
423             THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
424             RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
425             FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
426             SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
427             SUCH DAMAGES.