1package Log::Log4perl::Config::Watch;
2
3use constant _INTERNAL_DEBUG => 0;
4
5our $NEXT_CHECK_TIME;
6our $SIGNAL_CAUGHT;
7
8our $L4P_TEST_CHANGE_DETECTED;
9our $L4P_TEST_CHANGE_CHECKED;
10
11###########################################
12sub new {
13###########################################
14    my($class, %options) = @_;
15
16    my $self = { file            => "",
17                 check_interval  => 30,
18                 l4p_internal    => 0,
19                 signal          => undef,
20                 %options,
21                 _last_checked_at => 0,
22                 _last_timestamp  => 0,
23               };
24
25    bless $self, $class;
26
27    if($self->{signal}) {
28            # We're in signal mode, set up the handler
29        print "Setting up signal handler for '$self->{signal}'\n" if
30            _INTERNAL_DEBUG;
31
32        # save old signal handlers; they belong to other appenders or
33        # possibly something else in the consuming application
34        my $old_sig_handler = $SIG{$self->{signal}};
35        $SIG{$self->{signal}} = sub {
36            print "Caught $self->{signal} signal\n" if _INTERNAL_DEBUG;
37            $self->force_next_check();
38            $old_sig_handler->(@_) if $old_sig_handler and ref $old_sig_handler eq 'CODE';
39        };
40            # Reset the marker. The handler is going to modify it.
41        $self->{signal_caught} = 0;
42        $SIGNAL_CAUGHT = 0 if $self->{l4p_internal};
43    } else {
44            # Just called to initialize
45        $self->change_detected(undef, 1);
46        $self->file_has_moved(undef, 1);
47    }
48
49    return $self;
50}
51
52###########################################
53sub force_next_check {
54###########################################
55    my($self) = @_;
56
57    $self->{signal_caught}   = 1;
58    $self->{next_check_time} = 0;
59
60    if( $self->{l4p_internal} ) {
61        $SIGNAL_CAUGHT = 1;
62        $NEXT_CHECK_TIME = 0;
63    }
64}
65
66###########################################
67sub force_next_check_reset {
68###########################################
69    my($self) = @_;
70
71    $self->{signal_caught} = 0;
72    $SIGNAL_CAUGHT = 0 if $self->{l4p_internal};
73}
74
75###########################################
76sub file {
77###########################################
78    my($self) = @_;
79
80    return $self->{file};
81}
82
83###########################################
84sub signal {
85###########################################
86    my($self) = @_;
87
88    return $self->{signal};
89}
90
91###########################################
92sub check_interval {
93###########################################
94    my($self) = @_;
95
96    return $self->{check_interval};
97}
98
99###########################################
100sub file_has_moved {
101###########################################
102    my($self, $time, $force) = @_;
103
104    my $task = sub {
105        my @stat = stat($self->{file});
106
107        my $has_moved = 0;
108
109        if(! $stat[0]) {
110            # The file's gone, obviously it got moved or deleted.
111            print "File is gone\n" if _INTERNAL_DEBUG;
112            return 1;
113        }
114
115        my $current_inode = "$stat[0]:$stat[1]";
116        print "Current inode: $current_inode\n" if _INTERNAL_DEBUG;
117
118        if(exists $self->{_file_inode} and
119            $self->{_file_inode} ne $current_inode) {
120            print "Inode changed from $self->{_file_inode} to ",
121                  "$current_inode\n" if _INTERNAL_DEBUG;
122            $has_moved = 1;
123        }
124
125        $self->{_file_inode} = $current_inode;
126        return $has_moved;
127    };
128
129    return $self->check($time, $task, $force);
130}
131
132###########################################
133sub change_detected {
134###########################################
135    my($self, $time, $force) = @_;
136
137    my $task = sub {
138        my @stat = stat($self->{file});
139        my $new_timestamp = $stat[9];
140
141        $L4P_TEST_CHANGE_CHECKED = 1;
142
143        if(! defined $new_timestamp) {
144            if($self->{l4p_internal}) {
145                # The file is gone? Let it slide, we don't want L4p to re-read
146                # the config now, it's gonna die.
147                return undef;
148            }
149            $L4P_TEST_CHANGE_DETECTED = 1;
150            return 1;
151        }
152
153        if($new_timestamp > $self->{_last_timestamp}) {
154            $self->{_last_timestamp} = $new_timestamp;
155            print "Change detected (file=$self->{file} store=$new_timestamp)\n"
156                  if _INTERNAL_DEBUG;
157            $L4P_TEST_CHANGE_DETECTED = 1;
158            return 1; # Has changed
159        }
160
161        print "$self->{file} unchanged (file=$new_timestamp ",
162              "stored=$self->{_last_timestamp})!\n" if _INTERNAL_DEBUG;
163        return "";  # Hasn't changed
164    };
165
166    return $self->check($time, $task, $force);
167}
168
169###########################################
170sub check {
171###########################################
172    my($self, $time, $task, $force) = @_;
173
174    $time = time() unless defined $time;
175
176    if( $self->{signal_caught} or $SIGNAL_CAUGHT ) {
177       $force = 1;
178       $self->force_next_check_reset();
179       print "Caught signal, forcing check\n" if _INTERNAL_DEBUG;
180
181    }
182
183    print "Soft check (file=$self->{file} time=$time)\n" if _INTERNAL_DEBUG;
184
185        # Do we need to check?
186    if(!$force and
187       $self->{_last_checked_at} +
188       $self->{check_interval} > $time) {
189        print "No need to check\n" if _INTERNAL_DEBUG;
190        return ""; # don't need to check, return false
191    }
192
193    $self->{_last_checked_at} = $time;
194
195    # Set global var for optimizations in case we just have one watcher
196    # (like in Log::Log4perl)
197    $self->{next_check_time} = $time + $self->{check_interval};
198    $NEXT_CHECK_TIME = $self->{next_check_time} if $self->{l4p_internal};
199
200    print "Hard check (file=$self->{file} time=$time)\n" if _INTERNAL_DEBUG;
201    return $task->($time);
202}
203
2041;
205
206__END__
207
208=encoding utf8
209
210=head1 NAME
211
212Log::Log4perl::Config::Watch - Detect file changes
213
214=head1 SYNOPSIS
215
216    use Log::Log4perl::Config::Watch;
217
218    my $watcher = Log::Log4perl::Config::Watch->new(
219                          file            => "/data/my.conf",
220                          check_interval  => 30,
221                  );
222
223    while(1) {
224        if($watcher->change_detected()) {
225            print "Change detected!\n";
226        }
227        sleep(1);
228    }
229
230=head1 DESCRIPTION
231
232This module helps detecting changes in files. Although it comes with the
233C<Log::Log4perl> distribution, it can be used independently.
234
235The constructor defines the file to be watched and the check interval
236in seconds. Subsequent calls to C<change_detected()> will
237
238=over 4
239
240=item *
241
242return a false value immediately without doing physical file checks
243if C<check_interval> hasn't elapsed.
244
245=item *
246
247perform a physical test on the specified file if the number
248of seconds specified in C<check_interval>
249have elapsed since the last physical check. If the file's modification
250date has changed since the last physical check, it will return a true
251value, otherwise a false value is returned.
252
253=back
254
255Bottom line: C<check_interval> allows you to call the function
256C<change_detected()> as often as you like, without paying the performing
257a significant performance penalty because file system operations
258are being performed (however, you pay the price of not knowing about
259file changes until C<check_interval> seconds have elapsed).
260
261The module clearly distinguishes system time from file system time.
262If your (e.g. NFS mounted) file system is off by a constant amount
263of time compared to the executing computer's clock, it'll just
264work fine.
265
266To disable the resource-saving delay feature, just set C<check_interval>
267to 0 and C<change_detected()> will run a physical file test on
268every call.
269
270If you already have the current time available, you can pass it
271on to C<change_detected()> as an optional parameter, like in
272
273    change_detected($time)
274
275which then won't trigger a call to C<time()>, but use the value
276provided.
277
278=head2 SIGNAL MODE
279
280Instead of polling time and file changes, C<new()> can be instructed
281to set up a signal handler. If you call the constructor like
282
283    my $watcher = Log::Log4perl::Config::Watch->new(
284                          file    => "/data/my.conf",
285                          signal  => 'HUP'
286                  );
287
288then a signal handler will be installed, setting the object's variable
289C<$self-E<gt>{signal_caught}> to a true value when the signal arrives.
290Comes with all the problems that signal handlers go along with.
291
292=head2 TRIGGER CHECKS
293
294To trigger a physical file check on the next call to C<change_detected()>
295regardless if C<check_interval> has expired or not, call
296
297    $watcher->force_next_check();
298
299on the watcher object.
300
301=head2 DETECT MOVED FILES
302
303The watcher can also be used to detect files that have moved. It will
304not only detect if a watched file has disappeared, but also if it has
305been replaced by a new file in the meantime.
306
307    my $watcher = Log::Log4perl::Config::Watch->new(
308        file           => "/data/my.conf",
309        check_interval => 30,
310    );
311
312    while(1) {
313        if($watcher->file_has_moved()) {
314            print "File has moved!\n";
315        }
316        sleep(1);
317    }
318
319The parameters C<check_interval> and C<signal> limit the number of physical
320file system checks, similarily as with C<change_detected()>.
321
322=head1 LICENSE
323
324Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt>
325and Kevin Goess E<lt>cpan@goess.orgE<gt>.
326
327This library is free software; you can redistribute it and/or modify
328it under the same terms as Perl itself.
329
330=head1 AUTHOR
331
332Please contribute patches to the project on Github:
333
334    http://github.com/mschilli/log4perl
335
336Send bug reports or requests for enhancements to the authors via our
337
338MAILING LIST (questions, bug reports, suggestions/patches):
339log4perl-devel@lists.sourceforge.net
340
341Authors (please contact them via the list above, not directly):
342Mike Schilli <m@perlmeister.com>,
343Kevin Goess <cpan@goess.org>
344
345Contributors (in alphabetical order):
346Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
347Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
348Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
349Grundman, Paul Harrington, Alexander Hartmaier  David Hull,
350Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter,
351Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope,
352Lars Thegler, David Viner, Mac Yang.
353
354