← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:22:35 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Log/Log4perl/Config/Watch.pm
StatementsExecuted 8 statements in 714µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11112µs42µsLog::Log4perl::Config::Watch::::BEGIN@3Log::Log4perl::Config::Watch::BEGIN@3
0000s0sLog::Log4perl::Config::Watch::::__ANON__[:127]Log::Log4perl::Config::Watch::__ANON__[:127]
0000s0sLog::Log4perl::Config::Watch::::__ANON__[:164]Log::Log4perl::Config::Watch::__ANON__[:164]
0000s0sLog::Log4perl::Config::Watch::::__ANON__[:39]Log::Log4perl::Config::Watch::__ANON__[:39]
0000s0sLog::Log4perl::Config::Watch::::change_detectedLog::Log4perl::Config::Watch::change_detected
0000s0sLog::Log4perl::Config::Watch::::checkLog::Log4perl::Config::Watch::check
0000s0sLog::Log4perl::Config::Watch::::check_intervalLog::Log4perl::Config::Watch::check_interval
0000s0sLog::Log4perl::Config::Watch::::fileLog::Log4perl::Config::Watch::file
0000s0sLog::Log4perl::Config::Watch::::file_has_movedLog::Log4perl::Config::Watch::file_has_moved
0000s0sLog::Log4perl::Config::Watch::::force_next_checkLog::Log4perl::Config::Watch::force_next_check
0000s0sLog::Log4perl::Config::Watch::::force_next_check_resetLog::Log4perl::Config::Watch::force_next_check_reset
0000s0sLog::Log4perl::Config::Watch::::newLog::Log4perl::Config::Watch::new
0000s0sLog::Log4perl::Config::Watch::::signalLog::Log4perl::Config::Watch::signal
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Log::Log4perl::Config::Watch;
2
33711µs272µ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
use constant _INTERNAL_DEBUG => 0;
# spent 42µs making 1 call to Log::Log4perl::Config::Watch::BEGIN@3 # spent 30µs making 1 call to constant::import
4
51200nsour $NEXT_CHECK_TIME;
61100nsour $SIGNAL_CAUGHT;
7
810sour $L4P_TEST_CHANGE_DETECTED;
91100nsour $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
20412µs1;
205
206__END__