File Coverage

blib/lib/IO/Async/File.pm
Criterion Covered Total %
statement 55 56 98.2
branch 21 24 87.5
condition 20 23 86.9
subroutine 11 11 100.0
pod 3 3 100.0
total 110 117 94.0


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-2025 -- leonerd@leonerd.org.uk
5              
6             package IO::Async::File 0.805;
7              
8 3     3   1338 use v5.14;
  3         31  
9 3     3   18 use warnings;
  3         17  
  3         203  
10              
11 3     3   15 use base qw( IO::Async::Timer::Periodic );
  3         6  
  3         1197  
12              
13 3     3   21 use Carp;
  3         7  
  3         187  
14 3     3   1856 use File::stat;
  3         26422  
  3         2641  
15              
16             # No point watching blksize or blocks
17             my @STATS = qw( dev ino mode nlink uid gid rdev size atime mtime ctime );
18              
19             =head1 NAME
20              
21             C - watch a file for changes
22              
23             =head1 SYNOPSIS
24              
25             =for highlighter language=perl
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             I a named file does not necessarily need to exist. If it
57             is not present, all its C fields are treated as undefined; events will
58             be invoked when it becomes present or is removed, in addition to any changes.
59              
60             =cut
61              
62             =head1 EVENTS
63              
64             The following events are invoked, either using subclass methods or CODE
65             references in parameters.
66              
67             =head2 on_dev_changed $new_dev, $old_dev
68              
69             =head2 on_ino_changed $new_ino, $old_ino
70              
71             =head2 ...
72              
73             =head2 on_ctime_changed $new_ctime, $old_ctime
74              
75             Invoked when each of the individual C fields have changed. All the
76             C fields are supported apart from C and C. Each is
77             passed the new and old values of the field. Either field may be C if
78             the file did not or currently does not exist.
79              
80             =head2 on_devino_changed $new_stat, $old_stat
81              
82             Invoked when either of the C or C fields have changed. It is passed
83             two L instances containing the complete old and new C
84             fields. This can be used to observe when a named file is renamed; it will not
85             be observed to happen on opened filehandles.
86              
87             =head2 on_stat_changed $new_stat, $old_stat
88              
89             Invoked when any of the C fields have changed. It is passed two
90             L instances containing the old and new C fields. Either
91             value may be C if the file did not or currently does not exist.
92              
93             =cut
94              
95             =head1 PARAMETERS
96              
97             The following named parameters may be passed to C or C.
98              
99             =head2 handle => IO
100              
101             The opened filehandle to watch for C changes if C is not
102             supplied.
103              
104             =head2 filename => STRING
105              
106             Optional. If supplied, watches the named file rather than the filehandle given
107             in C. The file will be opened for reading and then watched for
108             renames. If the file is renamed, the new filename is opened and tracked
109             similarly after closing the previous file.
110              
111             =head2 interval => NUM
112              
113             Optional. The interval in seconds to poll the filehandle using C
114             looking for size changes. A default of 2 seconds will be applied if not
115             defined.
116              
117             =cut
118              
119             sub _init
120             {
121 9     9   17 my $self = shift;
122 9         23 my ( $params ) = @_;
123              
124 9   100     60 $params->{interval} ||= 2;
125              
126 9         49 $self->SUPER::_init( $params );
127              
128 9         33 $self->start;
129             }
130              
131             sub configure
132             {
133 24     24 1 64 my $self = shift;
134 24         83 my %params = @_;
135              
136 24 100       92 if( exists $params{filename} ) {
    100          
137 2         7 my $filename = delete $params{filename};
138 2         6 $self->{filename} = $filename;
139 2         8 $self->_reopen_file;
140             }
141             elsif( exists $params{handle} ) {
142 8         19 $self->{handle} = delete $params{handle};
143 8         42 $self->{last_stat} = stat $self->{handle};
144             }
145              
146 24         1953 foreach ( @STATS, "devino", "stat" ) {
147 312 100       720 $self->{"on_${_}_changed"} = delete $params{"on_${_}_changed"} if exists $params{"on_${_}_changed"};
148             }
149              
150 24         96 $self->SUPER::configure( %params );
151             }
152              
153             sub _add_to_loop
154             {
155 9     9   34 my $self = shift;
156              
157 9 50 66     72 if( !defined $self->{filename} and !defined $self->{handle} ) {
158 0         0 croak "IO::Async::File needs either a filename or a handle";
159             }
160              
161 9         44 return $self->SUPER::_add_to_loop( @_ );
162             }
163              
164             sub _reopen_file
165             {
166 6     6   13 my $self = shift;
167              
168 6         18 my $path = $self->{filename};
169              
170 6 100       389 if( open $self->{handle}, "<", $path ) {
171 5         34 $self->{last_stat} = stat $self->{handle};
172             }
173             else {
174 1         6 undef $self->{last_stat};
175             }
176             }
177              
178             sub on_tick
179             {
180 13     13 1 28 my $self = shift;
181              
182 13         41 my $old = $self->{last_stat};
183 13 100       121 my $new = stat( defined $self->{filename} ? $self->{filename} : $self->{handle} );
184              
185             # If it didn't and still doesn't exist, nothing to do
186 13 50 66     3167 defined $old or defined $new or
187             return;
188              
189             # From here onwards, one of $old or $new might be undef
190              
191 13         25 my $any_changed;
192 13         47 foreach my $stat ( @STATS ) {
193 143 100 100     4202 next if $old and $new and $old->$stat == $new->$stat;
      100        
194              
195 36         213 $any_changed++;
196 36 100       945 $self->maybe_invoke_event( "on_${stat}_changed",
    100          
197             ( $new ? $new->$stat : undef ),
198             ( $old ? $old->$stat : undef ) );
199             }
200              
201 13 100 100     393 if( !$old or !$new or $old->dev != $new->dev or $old->ino != $new->ino ) {
      66        
      100        
202 4         81 $self->maybe_invoke_event( on_devino_changed => $new, $old );
203 4         69 $self->_reopen_file;
204             }
205              
206 13 50       777 if( $any_changed ) {
207 13         50 $self->maybe_invoke_event( on_stat_changed => $new, $old );
208 13         81 $self->{last_stat} = $new;
209             }
210             }
211              
212             =head1 METHODS
213              
214             =cut
215              
216             =head2 handle
217              
218             $handle = $file->handle;
219              
220             Returns the filehandle currently associated with the instance; either the one
221             passed to the C parameter, or opened from the C parameter.
222              
223             =cut
224              
225             sub handle
226             {
227 11     11 1 11318 my $self = shift;
228 11         48 return $self->{handle};
229             }
230              
231             =head1 AUTHOR
232              
233             Paul Evans
234              
235             =cut
236              
237             0x55AA;