| Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Log/Log4perl/Config/Watch.pm |
| Statements | Executed 8 statements in 714µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 12µs | 42µs | Log::Log4perl::Config::Watch::BEGIN@3 |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Config::Watch::__ANON__[:127] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Config::Watch::__ANON__[:164] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Config::Watch::__ANON__[:39] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Config::Watch::change_detected |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Config::Watch::check |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Config::Watch::check_interval |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Config::Watch::file |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Config::Watch::file_has_moved |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Config::Watch::force_next_check |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Config::Watch::force_next_check_reset |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Config::Watch::new |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Config::Watch::signal |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Log::Log4perl::Config::Watch; | ||||
| 2 | |||||
| 3 | 3 | 711µs | 2 | 72µs | # spent 42µs (12+30) within Log::Log4perl::Config::Watch::BEGIN@3 which was called:
# once (12µs+30µs) by Log::Log4perl::Config::BEGIN@14 at line 3 # spent 42µs making 1 call to Log::Log4perl::Config::Watch::BEGIN@3
# spent 30µs making 1 call to constant::import |
| 4 | |||||
| 5 | 1 | 200ns | our $NEXT_CHECK_TIME; | ||
| 6 | 1 | 100ns | our $SIGNAL_CAUGHT; | ||
| 7 | |||||
| 8 | 1 | 0s | our $L4P_TEST_CHANGE_DETECTED; | ||
| 9 | 1 | 100ns | our $L4P_TEST_CHANGE_CHECKED; | ||
| 10 | |||||
| 11 | ########################################### | ||||
| 12 | sub 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 | ########################################### | ||||
| 53 | sub 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 | ########################################### | ||||
| 67 | sub 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 | ########################################### | ||||
| 76 | sub file { | ||||
| 77 | ########################################### | ||||
| 78 | my($self) = @_; | ||||
| 79 | |||||
| 80 | return $self->{file}; | ||||
| 81 | } | ||||
| 82 | |||||
| 83 | ########################################### | ||||
| 84 | sub signal { | ||||
| 85 | ########################################### | ||||
| 86 | my($self) = @_; | ||||
| 87 | |||||
| 88 | return $self->{signal}; | ||||
| 89 | } | ||||
| 90 | |||||
| 91 | ########################################### | ||||
| 92 | sub check_interval { | ||||
| 93 | ########################################### | ||||
| 94 | my($self) = @_; | ||||
| 95 | |||||
| 96 | return $self->{check_interval}; | ||||
| 97 | } | ||||
| 98 | |||||
| 99 | ########################################### | ||||
| 100 | sub 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 | ########################################### | ||||
| 133 | sub 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 | ########################################### | ||||
| 170 | sub 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 | |||||
| 204 | 1 | 2µs | 1; | ||
| 205 | |||||
| 206 | __END__ |