package Log::Log4perl::Config::Watch; use constant _INTERNAL_DEBUG => 0; our $NEXT_CHECK_TIME; our $SIGNAL_CAUGHT; ########################################### sub new { ########################################### my($class, %options) = @_; my $self = { file => "", check_interval => 30, l4p_internal => 0, signal => undef, %options, _last_checked_at => 0, _last_timestamp => 0, }; bless $self, $class; if($self->{signal}) { # We're in signal mode, set up the handler print "Setting up signal handler for '$self->{signal}'\n" if _INTERNAL_DEBUG; $SIG{$self->{signal}} = sub { $self->{signal_caught} = 1; print "Caught signal\n" if _INTERNAL_DEBUG; $SIGNAL_CAUGHT = 1 if $self->{l4p_internal}; }; # Reset the marker. The handler is going to modify it. $self->{signal_caught} = 0; $SIGNAL_CAUGHT = 0 if $self->{l4p_internal}; } else { # Just called to initialize $self->change_detected(undef, 1); $self->file_has_moved(undef, 1); } return $self; } ########################################### sub file { ########################################### my($self) = @_; return $self->{file}; } ########################################### sub signal { ########################################### my($self) = @_; return $self->{signal}; } ########################################### sub check_interval { ########################################### my($self) = @_; return $self->{check_interval}; } ########################################### sub file_has_moved { ########################################### my($self, $time, $force) = @_; my $task = sub { my @stat = stat($self->{file}); my $has_moved = 0; if(! $stat[0]) { # The file's gone, obviously it got moved or deleted. print "File is gone\n" if _INTERNAL_DEBUG; return 1; } my $current_inode = "$stat[0]:$stat[1]"; print "Current inode: $current_inode\n" if _INTERNAL_DEBUG; if(exists $self->{_file_inode} and $self->{_file_inode} ne $current_inode) { print "Inode changed from $self->{_file_inode} to ", "$current_inode\n" if _INTERNAL_DEBUG; $has_moved = 1; } $self->{_file_inode} = $current_inode; return $has_moved; }; return $self->check($time, $task, $force); } ########################################### sub change_detected { ########################################### my($self, $time, $force) = @_; my $task = sub { my @stat = stat($self->{file}); my $new_timestamp = $stat[9]; if(! defined $new_timestamp) { if($self->{l4p_internal}) { # The file is gone? Let it slide, we don't want L4p to re-read # the config now, it's gonna die. return undef; } return 1; } if($new_timestamp > $self->{_last_timestamp}) { $self->{_last_timestamp} = $new_timestamp; print "Change detected (file=$self->{file} store=$new_timestamp)\n" if _INTERNAL_DEBUG; return 1; # Has changed } print "$self->{file} unchanged (file=$new_timestamp ", "stored=$self->{_last_timestamp})!\n" if _INTERNAL_DEBUG; return ""; # Hasn't changed }; return $self->check($time, $task, $force); } ########################################### sub check { ########################################### my($self, $time, $task, $force) = @_; $time = time() unless defined $time; print "Soft check (file=$self->{file} time=$time)\n" if _INTERNAL_DEBUG; # Do we need to check? if(!$force and $self->{_last_checked_at} + $self->{check_interval} > $time) { print "No need to check\n" if _INTERNAL_DEBUG; return ""; # don't need to check, return false } $self->{_last_checked_at} = $time; # Set global var for optimizations in case we just have one watcher # (like in Log::Log4perl) $self->{next_check_time} = $time + $self->{check_interval}; $NEXT_CHECK_TIME = $self->{next_check_time} if $self->{l4p_internal}; print "Hard check (file=$self->{file} time=$time)\n" if _INTERNAL_DEBUG; return $task->($time); } 1; __END__ =head1 NAME Log::Log4perl::Config::Watch - Detect file changes =head1 SYNOPSIS use Log::Log4perl::Config::Watch; my $watcher = Log::Log4perl::Config::Watch->new( file => "/data/my.conf", check_interval => 30, ); while(1) { if($watcher->change_detected()) { print "Change detected!\n"; } sleep(1); } =head1 DESCRIPTION This module helps detecting changes in files. Although it comes with the C distribution, it can be used independly. The constructor defines the file to be watched and the check interval in seconds. Subsequent calls to C will =over 4 =item * return a false value immediately without doing physical file checks if C hasn't elapsed. =item * perform a physical test on the specified file if the number of seconds specified in C have elapsed since the last physical check. If the file's modification date has changed since the last physical check, it will return a true value, otherwise a false value is returned. =back Bottom line: C allows you to call the function C as often as you like, without paying the performing a significant performance penalty because file system operations are being performed (however, you pay the price of not knowing about file changes until C seconds have elapsed). The module clearly distinguishes system time from file system time. If your (e.g. NFS mounted) file system is off by a constant amount of time compared to the executing computer's clock, it'll just work fine. To disable the resource-saving delay feature, just set C to 0 and C will run a physical file test on every call. If you already have the current time available, you can pass it on to C as an optional parameter, like in change_detected($time) which then won't trigger a call to C, but use the value provided. =head2 SIGNAL MODE Instead of polling time and file changes, C can be instructed to set up a signal handler. If you call the constructor like my $watcher = Log::Log4perl::Config::Watch->new( file => "/data/my.conf", signal => 'HUP' ); then a signal handler will be installed, setting the object's variable C<$self-E{signal_caught}> to a true value when the signal arrives. Comes with all the problems that signal handlers go along with. =head1 SEE ALSO =head1 AUTHOR Mike Schilli, =cut =head1 COPYRIGHT AND LICENSE Copyright 2003 by Mike Schilli Em@perlmeister.comE and Kevin Goess Ecpan@goess.orgE. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut