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