File Coverage

blib/lib/Log/Log4perl/Config/Watch.pm
Criterion Covered Total %
statement 77 81 95.0
branch 23 28 82.1
condition 10 12 83.3
subroutine 13 13 100.0
pod 0 9 0.0
total 123 143 86.0


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