File Coverage

blib/lib/IO/Async/File.pm
Criterion Covered Total %
statement 54 55 98.1
branch 15 18 83.3
condition 6 8 75.0
subroutine 11 11 100.0
pod 3 3 100.0
total 89 95 93.6


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2012-2015 -- leonerd@leonerd.org.uk
5              
6             package IO::Async::File;
7              
8 3     3   1572 use strict;
  3         8  
  3         262  
9 3     3   20 use warnings;
  3         7  
  3         208  
10              
11             our $VERSION = '0.801';
12              
13 3     3   29 use base qw( IO::Async::Timer::Periodic );
  3         8  
  3         1156  
14              
15 3     3   25 use Carp;
  3         7  
  3         172  
16 3     3   2212 use File::stat;
  3         26351  
  3         15  
17              
18             # No point watching blksize or blocks
19             my @STATS = qw( dev ino mode nlink uid gid rdev size atime mtime ctime );
20              
21             =head1 NAME
22              
23             C - watch a file for changes
24              
25             =head1 SYNOPSIS
26              
27             use IO::Async::File;
28              
29             use IO::Async::Loop;
30             my $loop = IO::Async::Loop->new;
31              
32             my $file = IO::Async::File->new(
33             filename => "config.ini",
34             on_mtime_changed => sub {
35             my ( $self ) = @_;
36             print STDERR "Config file has changed\n";
37             reload_config( $self->handle );
38             }
39             );
40              
41             $loop->add( $file );
42              
43             $loop->run;
44              
45             =head1 DESCRIPTION
46              
47             This subclass of L watches an open filehandle or named
48             filesystem entity for changes in its C fields. It invokes various
49             events when the values of these fields change. It is most often used to watch
50             a file for size changes; for this task see also L.
51              
52             While called "File", it is not required that the watched filehandle be a
53             regular file. It is possible to watch anything that C may be called
54             on, such as directories or other filesystem entities.
55              
56             =cut
57              
58             =head1 EVENTS
59              
60             The following events are invoked, either using subclass methods or CODE
61             references in parameters.
62              
63             =head2 on_dev_changed $new_dev, $old_dev
64              
65             =head2 on_ino_changed $new_ino, $old_ino
66              
67             =head2 ...
68              
69             =head2 on_ctime_changed $new_ctime, $old_ctime
70              
71             Invoked when each of the individual C fields have changed. All the
72             C fields are supported apart from C and C. Each is
73             passed the new and old values of the field.
74              
75             =head2 on_devino_changed $new_stat, $old_stat
76              
77             Invoked when either of the C or C fields have changed. It is passed
78             two L instances containing the complete old and new C
79             fields. This can be used to observe when a named file is renamed; it will not
80             be observed to happen on opened filehandles.
81              
82             =head2 on_stat_changed $new_stat, $old_stat
83              
84             Invoked when any of the C fields have changed. It is passed two
85             L instances containing the old and new C fields.
86              
87             =cut
88              
89             =head1 PARAMETERS
90              
91             The following named parameters may be passed to C or C.
92              
93             =head2 handle => IO
94              
95             The opened filehandle to watch for C changes if C is not
96             supplied.
97              
98             =head2 filename => STRING
99              
100             Optional. If supplied, watches the named file rather than the filehandle given
101             in C. The file will be opened for reading and then watched for
102             renames. If the file is renamed, the new filename is opened and tracked
103             similarly after closing the previous file.
104              
105             =head2 interval => NUM
106              
107             Optional. The interval in seconds to poll the filehandle using C
108             looking for size changes. A default of 2 seconds will be applied if not
109             defined.
110              
111             =cut
112              
113             sub _init
114             {
115 9     9   23 my $self = shift;
116 9         25 my ( $params ) = @_;
117              
118 9   100     61 $params->{interval} ||= 2;
119              
120 9         53 $self->SUPER::_init( $params );
121              
122 9         65 $self->start;
123             }
124              
125             sub configure
126             {
127 24     24 1 50 my $self = shift;
128 24         74 my %params = @_;
129              
130 24 100       110 if( exists $params{filename} ) {
    100          
131 2         7 my $filename = delete $params{filename};
132 2         7 $self->{filename} = $filename;
133 2         1111 $self->_reopen_file;
134             }
135             elsif( exists $params{handle} ) {
136 8         31 $self->{handle} = delete $params{handle};
137 8         47 $self->{last_stat} = stat $self->{handle};
138             }
139              
140 24         2404 foreach ( @STATS, "devino", "stat" ) {
141 312 100       910 $self->{"on_${_}_changed"} = delete $params{"on_${_}_changed"} if exists $params{"on_${_}_changed"};
142             }
143              
144 24         120 $self->SUPER::configure( %params );
145             }
146              
147             sub _add_to_loop
148             {
149 9     9   21 my $self = shift;
150              
151 9 50 66     62 if( !defined $self->{filename} and !defined $self->{handle} ) {
152 0         0 croak "IO::Async::File needs either a filename or a handle";
153             }
154              
155 9         46 return $self->SUPER::_add_to_loop( @_ );
156             }
157              
158             sub _reopen_file
159             {
160 4     4   12 my $self = shift;
161              
162 4         13 my $path = $self->{filename};
163              
164 4 50       241 open $self->{handle}, "<", $path or croak "Cannot open $path for reading - $!";
165              
166 4         32 $self->{last_stat} = stat $self->{handle};
167             }
168              
169             sub on_tick
170             {
171 11     11 1 36 my $self = shift;
172              
173 11         36 my $old = $self->{last_stat};
174 11 100       131 my $new = stat( defined $self->{filename} ? $self->{filename} : $self->{handle} );
175              
176 11         3514 my $any_changed;
177 11         52 foreach my $stat ( @STATS ) {
178 121 100       3174 next if $old->$stat == $new->$stat;
179              
180 14         178 $any_changed++;
181 14         248 $self->maybe_invoke_event( "on_${stat}_changed", $new->$stat, $old->$stat );
182             }
183              
184 11 100 66     326 if( $old->dev != $new->dev or $old->ino != $new->ino ) {
185 2         81 $self->maybe_invoke_event( on_devino_changed => $new, $old );
186 2         18 $self->_reopen_file;
187             }
188              
189 11 50       675 if( $any_changed ) {
190 11         52 $self->maybe_invoke_event( on_stat_changed => $new, $old );
191 11         89 $self->{last_stat} = $new;
192             }
193             }
194              
195             =head1 METHODS
196              
197             =cut
198              
199             =head2 handle
200              
201             $handle = $file->handle
202              
203             Returns the filehandle currently associated with the instance; either the one
204             passed to the C parameter, or opened from the C parameter.
205              
206             =cut
207              
208             sub handle
209             {
210 11     11 1 2234 my $self = shift;
211 11         54 return $self->{handle};
212             }
213              
214             =head1 AUTHOR
215              
216             Paul Evans
217              
218             =cut
219              
220             0x55AA;