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 | BEGIN@3 | Log::Log4perl::Config::Watch::
0 | 0 | 0 | 0s | 0s | __ANON__[:127] | Log::Log4perl::Config::Watch::
0 | 0 | 0 | 0s | 0s | __ANON__[:164] | Log::Log4perl::Config::Watch::
0 | 0 | 0 | 0s | 0s | __ANON__[:39] | Log::Log4perl::Config::Watch::
0 | 0 | 0 | 0s | 0s | change_detected | Log::Log4perl::Config::Watch::
0 | 0 | 0 | 0s | 0s | check | Log::Log4perl::Config::Watch::
0 | 0 | 0 | 0s | 0s | check_interval | Log::Log4perl::Config::Watch::
0 | 0 | 0 | 0s | 0s | file | Log::Log4perl::Config::Watch::
0 | 0 | 0 | 0s | 0s | file_has_moved | Log::Log4perl::Config::Watch::
0 | 0 | 0 | 0s | 0s | force_next_check | Log::Log4perl::Config::Watch::
0 | 0 | 0 | 0s | 0s | force_next_check_reset | Log::Log4perl::Config::Watch::
0 | 0 | 0 | 0s | 0s | new | Log::Log4perl::Config::Watch::
0 | 0 | 0 | 0s | 0s | signal | Log::Log4perl::Config::Watch::
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__ |