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=head1 NAME
209
210Log::Log4perl::Config::Watch - Detect file changes
211
212=head1 SYNOPSIS
213
214    use Log::Log4perl::Config::Watch;
215
216    my $watcher = Log::Log4perl::Config::Watch->new(
217                          file            => "/data/my.conf",
218                          check_interval  => 30,
219                  );
220
221    while(1) {
222        if($watcher->change_detected()) {
223            print "Change detected!\n";
224        }
225        sleep(1);
226    }
227
228=head1 DESCRIPTION
229
230This module helps detecting changes in files. Although it comes with the
231C<Log::Log4perl> distribution, it can be used independently.
232
233The constructor defines the file to be watched and the check interval
234in seconds. Subsequent calls to C<change_detected()> will
235
236=over 4
237
238=item *
239
240return a false value immediately without doing physical file checks
241if C<check_interval> hasn't elapsed.
242
243=item *
244
245perform a physical test on the specified file if the number
246of seconds specified in C<check_interval>
247have elapsed since the last physical check. If the file's modification
248date has changed since the last physical check, it will return a true
249value, otherwise a false value is returned.
250
251=back
252
253Bottom line: C<check_interval> allows you to call the function
254C<change_detected()> as often as you like, without paying the performing
255a significant performance penalty because file system operations
256are being performed (however, you pay the price of not knowing about
257file changes until C<check_interval> seconds have elapsed).
258
259The module clearly distinguishes system time from file system time.
260If your (e.g. NFS mounted) file system is off by a constant amount
261of time compared to the executing computer's clock, it'll just
262work fine.
263
264To disable the resource-saving delay feature, just set C<check_interval>
265to 0 and C<change_detected()> will run a physical file test on
266every call.
267
268If you already have the current time available, you can pass it
269on to C<change_detected()> as an optional parameter, like in
270
271    change_detected($time)
272
273which then won't trigger a call to C<time()>, but use the value
274provided.
275
276=head2 SIGNAL MODE
277
278Instead of polling time and file changes, C<new()> can be instructed
279to set up a signal handler. If you call the constructor like
280
281    my $watcher = Log::Log4perl::Config::Watch->new(
282                          file    => "/data/my.conf",
283                          signal  => 'HUP'
284                  );
285
286then a signal handler will be installed, setting the object's variable
287C<$self-E<gt>{signal_caught}> to a true value when the signal arrives.
288Comes with all the problems that signal handlers go along with.
289
290=head2 TRIGGER CHECKS
291
292To trigger a physical file check on the next call to C<change_detected()>
293regardless if C<check_interval> has expired or not, call
294
295    $watcher->force_next_check();
296
297on the watcher object.
298
299=head2 DETECT MOVED FILES
300
301The watcher can also be used to detect files that have moved. It will
302not only detect if a watched file has disappeared, but also if it has
303been replaced by a new file in the meantime.
304
305    my $watcher = Log::Log4perl::Config::Watch->new(
306        file           => "/data/my.conf",
307        check_interval => 30,
308    );
309
310    while(1) {
311        if($watcher->file_has_moved()) {
312            print "File has moved!\n";
313        }
314        sleep(1);
315    }
316
317The parameters C<check_interval> and C<signal> limit the number of physical
318file system checks, simililarily as with C<change_detected()>.
319
320=head1 LICENSE
321
322Copyright 2002-2012 by Mike Schilli E<lt>m@perlmeister.comE<gt>
323and Kevin Goess E<lt>cpan@goess.orgE<gt>.
324
325This library is free software; you can redistribute it and/or modify
326it under the same terms as Perl itself.
327
328=head1 AUTHOR
329
330Please contribute patches to the project on Github:
331
332    http://github.com/mschilli/log4perl
333
334Send bug reports or requests for enhancements to the authors via our
335
336MAILING LIST (questions, bug reports, suggestions/patches):
337log4perl-devel@lists.sourceforge.net
338
339Authors (please contact them via the list above, not directly):
340Mike Schilli <m@perlmeister.com>,
341Kevin Goess <cpan@goess.org>
342
343Contributors (in alphabetical order):
344Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
345Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
346Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
347Grundman, Paul Harrington, David Hull, Robert Jacobson, Jason Kohles,
348Jeff Macdonald, Markus Peter, Brett Rann, Peter Rabbitson, Erik
349Selberg, Aaron Straup Cope, Lars Thegler, David Viner, Mac Yang.
350
351