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