1package Log::Log4perl::Config::Watch;
2
3use constant _INTERNAL_DEBUG => 0;
4
5our $NEXT_CHECK_TIME;
6our $SIGNAL_CAUGHT;
7
8###########################################
9sub new {
10###########################################
11    my($class, %options) = @_;
12
13    my $self = { file            => "",
14                 check_interval  => 30,
15                 l4p_internal    => 0,
16                 signal          => undef,
17                 %options,
18                 _last_checked_at => 0,
19                 _last_timestamp  => 0,
20               };
21
22    bless $self, $class;
23
24    if($self->{signal}) {
25            # We're in signal mode, set up the handler
26        print "Setting up signal handler for '$self->{signal}'\n" if
27            _INTERNAL_DEBUG;
28        $SIG{$self->{signal}} = sub {
29            $self->{signal_caught} = 1;
30            print "Caught signal\n" if _INTERNAL_DEBUG;
31            $SIGNAL_CAUGHT = 1 if $self->{l4p_internal};
32        };
33            # Reset the marker. The handler is going to modify it.
34        $self->{signal_caught} = 0;
35        $SIGNAL_CAUGHT = 0 if $self->{l4p_internal};
36    } else {
37            # Just called to initialize
38        $self->change_detected(undef, 1);
39        $self->file_has_moved(undef, 1);
40    }
41
42    return $self;
43}
44
45###########################################
46sub file {
47###########################################
48    my($self) = @_;
49
50    return $self->{file};
51}
52
53###########################################
54sub signal {
55###########################################
56    my($self) = @_;
57
58    return $self->{signal};
59}
60
61###########################################
62sub check_interval {
63###########################################
64    my($self) = @_;
65
66    return $self->{check_interval};
67}
68
69###########################################
70sub file_has_moved {
71###########################################
72    my($self, $time, $force) = @_;
73
74    my $task = sub {
75        my @stat = stat($self->{file});
76
77        my $has_moved = 0;
78
79        if(! $stat[0]) {
80            # The file's gone, obviously it got moved or deleted.
81            print "File is gone\n" if _INTERNAL_DEBUG;
82            return 1;
83        }
84
85        my $current_inode = "$stat[0]:$stat[1]";
86        print "Current inode: $current_inode\n" if _INTERNAL_DEBUG;
87
88        if(exists $self->{_file_inode} and
89            $self->{_file_inode} ne $current_inode) {
90            print "Inode changed from $self->{_file_inode} to ",
91                  "$current_inode\n" if _INTERNAL_DEBUG;
92            $has_moved = 1;
93        }
94
95        $self->{_file_inode} = $current_inode;
96        return $has_moved;
97    };
98
99    return $self->check($time, $task, $force);
100}
101
102###########################################
103sub change_detected {
104###########################################
105    my($self, $time, $force) = @_;
106
107    my $task = sub {
108        my @stat = stat($self->{file});
109        my $new_timestamp = $stat[9];
110
111        if(! defined $new_timestamp) {
112            if($self->{l4p_internal}) {
113                # The file is gone? Let it slide, we don't want L4p to re-read
114                # the config now, it's gonna die.
115                return undef;
116            }
117            return 1;
118        }
119
120        if($new_timestamp > $self->{_last_timestamp}) {
121            $self->{_last_timestamp} = $new_timestamp;
122            print "Change detected (file=$self->{file} store=$new_timestamp)\n"
123                  if _INTERNAL_DEBUG;
124            return 1; # Has changed
125        }
126
127        print "$self->{file} unchanged (file=$new_timestamp ",
128              "stored=$self->{_last_timestamp})!\n" if _INTERNAL_DEBUG;
129        return "";  # Hasn't changed
130    };
131
132    return $self->check($time, $task, $force);
133}
134
135###########################################
136sub check {
137###########################################
138    my($self, $time, $task, $force) = @_;
139
140    $time = time() unless defined $time;
141
142    print "Soft check (file=$self->{file} time=$time)\n" if _INTERNAL_DEBUG;
143
144        # Do we need to check?
145    if(!$force and
146       $self->{_last_checked_at} +
147       $self->{check_interval} > $time) {
148        print "No need to check\n" if _INTERNAL_DEBUG;
149        return ""; # don't need to check, return false
150    }
151
152    $self->{_last_checked_at} = $time;
153
154    # Set global var for optimizations in case we just have one watcher
155    # (like in Log::Log4perl)
156    $self->{next_check_time} = $time + $self->{check_interval};
157    $NEXT_CHECK_TIME = $self->{next_check_time} if $self->{l4p_internal};
158
159    print "Hard check (file=$self->{file} time=$time)\n" if _INTERNAL_DEBUG;
160    return $task->($time);
161}
162
1631;
164
165__END__
166
167=head1 NAME
168
169Log::Log4perl::Config::Watch - Detect file changes
170
171=head1 SYNOPSIS
172
173    use Log::Log4perl::Config::Watch;
174
175    my $watcher = Log::Log4perl::Config::Watch->new(
176                          file            => "/data/my.conf",
177                          check_interval  => 30,
178                  );
179
180    while(1) {
181        if($watcher->change_detected()) {
182            print "Change detected!\n";
183        }
184        sleep(1);
185    }
186
187=head1 DESCRIPTION
188
189This module helps detecting changes in files. Although it comes with the
190C<Log::Log4perl> distribution, it can be used independly.
191
192The constructor defines the file to be watched and the check interval
193in seconds. Subsequent calls to C<change_detected()> will
194
195=over 4
196
197=item *
198
199return a false value immediately without doing physical file checks
200if C<check_interval> hasn't elapsed.
201
202=item *
203
204perform a physical test on the specified file if the number
205of seconds specified in C<check_interval>
206have elapsed since the last physical check. If the file's modification
207date has changed since the last physical check, it will return a true
208value, otherwise a false value is returned.
209
210=back
211
212Bottom line: C<check_interval> allows you to call the function
213C<change_detected()> as often as you like, without paying the performing
214a significant performance penalty because file system operations
215are being performed (however, you pay the price of not knowing about
216file changes until C<check_interval> seconds have elapsed).
217
218The module clearly distinguishes system time from file system time.
219If your (e.g. NFS mounted) file system is off by a constant amount
220of time compared to the executing computer's clock, it'll just
221work fine.
222
223To disable the resource-saving delay feature, just set C<check_interval>
224to 0 and C<change_detected()> will run a physical file test on
225every call.
226
227If you already have the current time available, you can pass it
228on to C<change_detected()> as an optional parameter, like in
229
230    change_detected($time)
231
232which then won't trigger a call to C<time()>, but use the value
233provided.
234
235=head2 SIGNAL MODE
236
237Instead of polling time and file changes, C<new()> can be instructed
238to set up a signal handler. If you call the constructor like
239
240    my $watcher = Log::Log4perl::Config::Watch->new(
241                          file    => "/data/my.conf",
242                          signal  => 'HUP'
243                  );
244
245then a signal handler will be installed, setting the object's variable
246C<$self-E<gt>{signal_caught}>
247to a true value when
248the signal arrives. Comes with all the problems that signal handlers
249go along with.
250
251=head1 SEE ALSO
252
253=head1 AUTHOR
254
255    Mike Schilli, <log4perl@perlmeister.com>
256
257=cut
258
259=head1 COPYRIGHT AND LICENSE
260
261Copyright 2003 by Mike Schilli E<lt>m@perlmeister.comE<gt> and Kevin Goess
262E<lt>cpan@goess.orgE<gt>.
263
264This library is free software; you can redistribute it and/or modify
265it under the same terms as Perl itself.
266
267=cut
268