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
6package IO::Async::File;
7
8use strict;
9use warnings;
10
11our $VERSION = '0.800';
12
13use base qw( IO::Async::Timer::Periodic );
14
15use Carp;
16use File::stat;
17
18# No point watching blksize or blocks
19my @STATS = qw( dev ino mode nlink uid gid rdev size atime mtime ctime );
20
21=head1 NAME
22
23C<IO::Async::File> - 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
47This subclass of L<IO::Async::Notifier> watches an open filehandle or named
48filesystem entity for changes in its C<stat()> fields. It invokes various
49events when the values of these fields change. It is most often used to watch
50a file for size changes; for this task see also L<IO::Async::FileStream>.
51
52While called "File", it is not required that the watched filehandle be a
53regular file. It is possible to watch anything that C<stat(2)> may be called
54on, such as directories or other filesystem entities.
55
56=cut
57
58=head1 EVENTS
59
60The following events are invoked, either using subclass methods or CODE
61references 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
71Invoked when each of the individual C<stat()> fields have changed. All the
72C<stat()> fields are supported apart from C<blocks> and C<blksize>. Each is
73passed the new and old values of the field.
74
75=head2 on_devino_changed $new_stat, $old_stat
76
77Invoked when either of the C<dev> or C<ino> fields have changed. It is passed
78two L<File::stat> instances containing the complete old and new C<stat()>
79fields. This can be used to observe when a named file is renamed; it will not
80be observed to happen on opened filehandles.
81
82=head2 on_stat_changed $new_stat, $old_stat
83
84Invoked when any of the C<stat()> fields have changed. It is passed two
85L<File::stat> instances containing the old and new C<stat()> fields.
86
87=cut
88
89=head1 PARAMETERS
90
91The following named parameters may be passed to C<new> or C<configure>.
92
93=head2 handle => IO
94
95The opened filehandle to watch for C<stat()> changes if C<filename> is not
96supplied.
97
98=head2 filename => STRING
99
100Optional. If supplied, watches the named file rather than the filehandle given
101in C<handle>. The file will be opened for reading and then watched for
102renames. If the file is renamed, the new filename is opened and tracked
103similarly after closing the previous file.
104
105=head2 interval => NUM
106
107Optional. The interval in seconds to poll the filehandle using C<stat(2)>
108looking for size changes. A default of 2 seconds will be applied if not
109defined.
110
111=cut
112
113sub _init
114{
115   my $self = shift;
116   my ( $params ) = @_;
117
118   $params->{interval} ||= 2;
119
120   $self->SUPER::_init( $params );
121
122   $self->start;
123}
124
125sub configure
126{
127   my $self = shift;
128   my %params = @_;
129
130   if( exists $params{filename} ) {
131      my $filename = delete $params{filename};
132      $self->{filename} = $filename;
133      $self->_reopen_file;
134   }
135   elsif( exists $params{handle} ) {
136      $self->{handle} = delete $params{handle};
137      $self->{last_stat} = stat $self->{handle};
138   }
139
140   foreach ( @STATS, "devino", "stat" ) {
141      $self->{"on_${_}_changed"} = delete $params{"on_${_}_changed"} if exists $params{"on_${_}_changed"};
142   }
143
144   $self->SUPER::configure( %params );
145}
146
147sub _add_to_loop
148{
149   my $self = shift;
150
151   if( !defined $self->{filename} and !defined $self->{handle} ) {
152      croak "IO::Async::File needs either a filename or a handle";
153   }
154
155   return $self->SUPER::_add_to_loop( @_ );
156}
157
158sub _reopen_file
159{
160   my $self = shift;
161
162   my $path = $self->{filename};
163
164   open $self->{handle}, "<", $path or croak "Cannot open $path for reading - $!";
165
166   $self->{last_stat} = stat $self->{handle};
167}
168
169sub on_tick
170{
171   my $self = shift;
172
173   my $old = $self->{last_stat};
174   my $new = stat( defined $self->{filename} ? $self->{filename} : $self->{handle} );
175
176   my $any_changed;
177   foreach my $stat ( @STATS ) {
178      next if $old->$stat == $new->$stat;
179
180      $any_changed++;
181      $self->maybe_invoke_event( "on_${stat}_changed", $new->$stat, $old->$stat );
182   }
183
184   if( $old->dev != $new->dev or $old->ino != $new->ino ) {
185      $self->maybe_invoke_event( on_devino_changed => $new, $old );
186      $self->_reopen_file;
187   }
188
189   if( $any_changed ) {
190      $self->maybe_invoke_event( on_stat_changed => $new, $old );
191      $self->{last_stat} = $new;
192   }
193}
194
195=head1 METHODS
196
197=cut
198
199=head2 handle
200
201   $handle = $file->handle
202
203Returns the filehandle currently associated with the instance; either the one
204passed to the C<handle> parameter, or opened from the C<filename> parameter.
205
206=cut
207
208sub handle
209{
210   my $self = shift;
211   return $self->{handle};
212}
213
214=head1 AUTHOR
215
216Paul Evans <leonerd@leonerd.org.uk>
217
218=cut
219
2200x55AA;
221