Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Log/Log4perl/Appender.pm |
Statements | Executed 43 statements in 1.10ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 3.47ms | 7.53ms | BEGIN@10 | Log::Log4perl::Appender::
1 | 1 | 1 | 45µs | 67µs | new | Log::Log4perl::Appender::
1 | 1 | 1 | 29µs | 29µs | BEGIN@5 | Log::Log4perl::Appender::
1 | 1 | 1 | 12µs | 31µs | BEGIN@180 | Log::Log4perl::Appender::
1 | 1 | 1 | 12µs | 64µs | BEGIN@12 | Log::Log4perl::Appender::
1 | 1 | 1 | 9µs | 66µs | BEGIN@9 | Log::Log4perl::Appender::
1 | 1 | 1 | 8µs | 24µs | BEGIN@7 | Log::Log4perl::Appender::
1 | 1 | 1 | 7µs | 12µs | BEGIN@6 | Log::Log4perl::Appender::
1 | 1 | 1 | 7µs | 15µs | BEGIN@266 | Log::Log4perl::Appender::
1 | 1 | 1 | 4µs | 4µs | layout | Log::Log4perl::Appender::
1 | 1 | 1 | 3µs | 3µs | CORE:match (opcode) | Log::Log4perl::Appender::
1 | 1 | 1 | 3µs | 3µs | reset | Log::Log4perl::Appender::
0 | 0 | 0 | 0s | 0s | AUTOLOAD | Log::Log4perl::Appender::
0 | 0 | 0 | 0s | 0s | DESTROY | Log::Log4perl::Appender::
0 | 0 | 0 | 0s | 0s | composite | Log::Log4perl::Appender::
0 | 0 | 0 | 0s | 0s | filter | Log::Log4perl::Appender::
0 | 0 | 0 | 0s | 0s | log | Log::Log4perl::Appender::
0 | 0 | 0 | 0s | 0s | log_cached | Log::Log4perl::Appender::
0 | 0 | 0 | 0s | 0s | name | Log::Log4perl::Appender::
0 | 0 | 0 | 0s | 0s | threshold | Log::Log4perl::Appender::
0 | 0 | 0 | 0s | 0s | unique_name | Log::Log4perl::Appender::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | ################################################## | ||||
2 | package Log::Log4perl::Appender; | ||||
3 | ################################################## | ||||
4 | |||||
5 | 3 | 38µs | 1 | 29µs | # spent 29µs within Log::Log4perl::Appender::BEGIN@5 which was called:
# once (29µs+0s) by Log::Log4perl::Logger::BEGIN@12 at line 5 # spent 29µs making 1 call to Log::Log4perl::Appender::BEGIN@5 |
6 | 3 | 17µs | 2 | 16µs | # spent 12µs (7+4) within Log::Log4perl::Appender::BEGIN@6 which was called:
# once (7µs+4µs) by Log::Log4perl::Logger::BEGIN@12 at line 6 # spent 12µs making 1 call to Log::Log4perl::Appender::BEGIN@6
# spent 4µs making 1 call to strict::import |
7 | 3 | 18µs | 2 | 40µs | # spent 24µs (8+16) within Log::Log4perl::Appender::BEGIN@7 which was called:
# once (8µs+16µs) by Log::Log4perl::Logger::BEGIN@12 at line 7 # spent 24µs making 1 call to Log::Log4perl::Appender::BEGIN@7
# spent 16µs making 1 call to warnings::import |
8 | |||||
9 | 3 | 19µs | 2 | 123µs | # spent 66µs (9+57) within Log::Log4perl::Appender::BEGIN@9 which was called:
# once (9µs+57µs) by Log::Log4perl::Logger::BEGIN@12 at line 9 # spent 66µs making 1 call to Log::Log4perl::Appender::BEGIN@9
# spent 57µs making 1 call to Log::Log4perl::Level::import |
10 | 3 | 92µs | 1 | 7.53ms | # spent 7.53ms (3.47+4.06) within Log::Log4perl::Appender::BEGIN@10 which was called:
# once (3.47ms+4.06ms) by Log::Log4perl::Logger::BEGIN@12 at line 10 # spent 7.53ms making 1 call to Log::Log4perl::Appender::BEGIN@10 |
11 | |||||
12 | 3 | 486µs | 2 | 116µs | # spent 64µs (12+52) within Log::Log4perl::Appender::BEGIN@12 which was called:
# once (12µs+52µs) by Log::Log4perl::Logger::BEGIN@12 at line 12 # spent 64µs making 1 call to Log::Log4perl::Appender::BEGIN@12
# spent 52µs making 1 call to constant::import |
13 | |||||
14 | 1 | 300ns | our $unique_counter = 0; | ||
15 | |||||
16 | ################################################## | ||||
17 | # spent 3µs within Log::Log4perl::Appender::reset which was called:
# once (3µs+0s) by Log::Log4perl::Logger::reset at line 97 of Log/Log4perl/Logger.pm | ||||
18 | ################################################## | ||||
19 | 1 | 3µs | $unique_counter = 0; | ||
20 | } | ||||
21 | |||||
22 | ################################################## | ||||
23 | sub unique_name { | ||||
24 | ################################################## | ||||
25 | # THREADS: Need to lock here to make it thread safe | ||||
26 | $unique_counter++; | ||||
27 | my $unique_name = sprintf("app%03d", $unique_counter); | ||||
28 | # THREADS: Need to unlock here to make it thread safe | ||||
29 | return $unique_name; | ||||
30 | } | ||||
31 | |||||
32 | ################################################## | ||||
33 | # spent 67µs (45+22) within Log::Log4perl::Appender::new which was called:
# once (45µs+22µs) by Log::Log4perl::BEGIN@12 at line 33 of Log/Log4perl/Logger.pm | ||||
34 | ################################################## | ||||
35 | 1 | 3µs | my($class, $appenderclass, %params) = @_; | ||
36 | |||||
37 | # Pull in the specified Log::Log4perl::Appender object | ||||
38 | 1 | 1µs | eval { | ||
39 | |||||
40 | # Eval erroneously succeeds on unknown appender classes if | ||||
41 | # the eval string just consists of valid perl code (e.g. an | ||||
42 | # appended ';' in $appenderclass variable). Fail if we see | ||||
43 | # anything in there that can't be class name. | ||||
44 | 1 | 10µs | 1 | 3µs | die "'$appenderclass' not a valid class name " if # spent 3µs making 1 call to Log::Log4perl::Appender::CORE:match |
45 | $appenderclass =~ /[^:\w]/; | ||||
46 | |||||
47 | # Check if the class/package is already available because | ||||
48 | # something like Class::Prototyped injected it previously. | ||||
49 | |||||
50 | # Use UNIVERSAL::can to check the appender's new() method | ||||
51 | # [RT 28987] | ||||
52 | 1 | 15µs | 1 | 3µs | if( ! $appenderclass->can('new') ) { # spent 3µs making 1 call to UNIVERSAL::can |
53 | # Not available yet, try to pull it in. | ||||
54 | # see 'perldoc -f require' for why two evals | ||||
55 | eval "require $appenderclass"; | ||||
56 | #unless ${$appenderclass.'::IS_LOADED'}; #for unit tests, | ||||
57 | #see 004Config | ||||
58 | die $@ if $@; | ||||
59 | } | ||||
60 | }; | ||||
61 | |||||
62 | 1 | 200ns | $@ and die "ERROR: can't load appenderclass '$appenderclass'\n$@"; | ||
63 | |||||
64 | 1 | 700ns | $params{name} = unique_name() unless exists $params{name}; | ||
65 | |||||
66 | # If it's a Log::Dispatch::File appender, default to append | ||||
67 | # mode (Log::Dispatch::File defaults to 'clobber') -- consensus 9/2002 | ||||
68 | # (Log::Log4perl::Appender::File already defaults to 'append') | ||||
69 | 1 | 800ns | if ($appenderclass eq 'Log::Dispatch::File' && | ||
70 | ! exists $params{mode}) { | ||||
71 | $params{mode} = 'append'; | ||||
72 | } | ||||
73 | |||||
74 | my $appender = $appenderclass->new( | ||||
75 | # Set min_level to the lowest setting. *we* are | ||||
76 | # controlling this now, the appender should just | ||||
77 | # log it with no questions asked. | ||||
78 | min_level => 'debug', | ||||
79 | # Set 'name' and other parameters | ||||
80 | 1 | 7µs | 1 | 16µs | map { $_ => $params{$_} } keys %params, # spent 16µs making 1 call to Log::Log4perl::Appender::String::new |
81 | ); | ||||
82 | |||||
83 | 1 | 4µs | my $self = { | ||
84 | appender => $appender, | ||||
85 | name => $params{name}, | ||||
86 | layout => undef, | ||||
87 | level => $ALL, | ||||
88 | composite => 0, | ||||
89 | }; | ||||
90 | |||||
91 | #whether to collapse arrays, etc. | ||||
92 | 1 | 1µs | $self->{warp_message} = $params{warp_message}; | ||
93 | 1 | 900ns | if($self->{warp_message} and | ||
94 | my $cref = | ||||
95 | Log::Log4perl::Config::compile_if_perl($self->{warp_message})) { | ||||
96 | $self->{warp_message} = $cref; | ||||
97 | } | ||||
98 | |||||
99 | 1 | 2µs | bless $self, $class; | ||
100 | |||||
101 | 1 | 12µs | return $self; | ||
102 | } | ||||
103 | |||||
104 | ################################################## | ||||
105 | sub composite { # Set/Get the composite flag | ||||
106 | ################################################## | ||||
107 | my ($self, $flag) = @_; | ||||
108 | |||||
109 | $self->{composite} = $flag if defined $flag; | ||||
110 | return $self->{composite}; | ||||
111 | } | ||||
112 | |||||
113 | ################################################## | ||||
114 | sub threshold { # Set/Get the appender threshold | ||||
115 | ################################################## | ||||
116 | my ($self, $level) = @_; | ||||
117 | |||||
118 | print "Setting threshold to $level\n" if _INTERNAL_DEBUG; | ||||
119 | |||||
120 | if(defined $level) { | ||||
121 | # Checking for \d makes for a faster regex(p) | ||||
122 | $self->{level} = ($level =~ /^(\d+)$/) ? $level : | ||||
123 | # Take advantage of &to_priority's error reporting | ||||
124 | Log::Log4perl::Level::to_priority($level); | ||||
125 | } | ||||
126 | |||||
127 | return $self->{level}; | ||||
128 | } | ||||
129 | |||||
130 | ################################################## | ||||
131 | sub log { | ||||
132 | ################################################## | ||||
133 | # Relay this call to Log::Log4perl::Appender:* or | ||||
134 | # Log::Dispatch::* | ||||
135 | ################################################## | ||||
136 | my ($self, $p, $category, $level, $cache) = @_; | ||||
137 | |||||
138 | # Check if the appender has a last-minute veto in form | ||||
139 | # of an "appender threshold" | ||||
140 | if($self->{level} > $ | ||||
141 | Log::Log4perl::Level::PRIORITY{$level}) { | ||||
142 | print "$self->{level} > $level, aborting\n" if _INTERNAL_DEBUG; | ||||
143 | return undef; | ||||
144 | } | ||||
145 | |||||
146 | # Run against the (yes only one) customized filter (which in turn | ||||
147 | # might call other filters via the Boolean filter) and check if its | ||||
148 | # ok() method approves the message or blocks it. | ||||
149 | if($self->{filter}) { | ||||
150 | if($self->{filter}->ok(%$p, | ||||
151 | log4p_category => $category, | ||||
152 | log4p_level => $level )) { | ||||
153 | print "Filter $self->{filter}->{name} passes\n" if _INTERNAL_DEBUG; | ||||
154 | } else { | ||||
155 | print "Filter $self->{filter}->{name} blocks\n" if _INTERNAL_DEBUG; | ||||
156 | return undef; | ||||
157 | } | ||||
158 | } | ||||
159 | |||||
160 | unless($self->composite()) { | ||||
161 | |||||
162 | #not defined, the normal case | ||||
163 | if (! defined $self->{warp_message} ){ | ||||
164 | #join any message elements | ||||
165 | $p->{message} = | ||||
166 | join($Log::Log4perl::JOIN_MSG_ARRAY_CHAR, | ||||
167 | @{$p->{message}} | ||||
168 | ) if ref $p->{message} eq "ARRAY"; | ||||
169 | |||||
170 | #defined but false, e.g. Appender::DBI | ||||
171 | } elsif (! $self->{warp_message}) { | ||||
172 | ; #leave the message alone | ||||
173 | |||||
174 | } elsif (ref($self->{warp_message}) eq "CODE") { | ||||
175 | #defined and a subref | ||||
176 | $p->{message} = | ||||
177 | [$self->{warp_message}->(@{$p->{message}})]; | ||||
178 | } else { | ||||
179 | #defined and a function name? | ||||
180 | 3 | 266µs | 2 | 49µs | # spent 31µs (12+18) within Log::Log4perl::Appender::BEGIN@180 which was called:
# once (12µs+18µs) by Log::Log4perl::Logger::BEGIN@12 at line 180 # spent 31µs making 1 call to Log::Log4perl::Appender::BEGIN@180
# spent 18µs making 1 call to strict::unimport |
181 | $p->{message} = | ||||
182 | [$self->{warp_message}->(@{$p->{message}})]; | ||||
183 | } | ||||
184 | |||||
185 | $p->{message} = $self->{layout}->render($p->{message}, | ||||
186 | $category, | ||||
187 | $level, | ||||
188 | 3 + $Log::Log4perl::caller_depth, | ||||
189 | ) if $self->layout(); | ||||
190 | } | ||||
191 | |||||
192 | my $args = [%$p, log4p_category => $category, log4p_level => $level]; | ||||
193 | |||||
194 | if(defined $cache) { | ||||
195 | $$cache = $args; | ||||
196 | } else { | ||||
197 | $self->{appender}->log(@$args); | ||||
198 | } | ||||
199 | |||||
200 | return 1; | ||||
201 | } | ||||
202 | |||||
203 | ########################################### | ||||
204 | sub log_cached { | ||||
205 | ########################################### | ||||
206 | my ($self, $cache) = @_; | ||||
207 | |||||
208 | $self->{appender}->log(@$cache); | ||||
209 | } | ||||
210 | |||||
211 | ################################################## | ||||
212 | sub name { # Set/Get the name | ||||
213 | ################################################## | ||||
214 | my($self, $name) = @_; | ||||
215 | |||||
216 | # Somebody wants to *set* the name? | ||||
217 | if($name) { | ||||
218 | $self->{name} = $name; | ||||
219 | } | ||||
220 | |||||
221 | return $self->{name}; | ||||
222 | } | ||||
223 | |||||
224 | ########################################### | ||||
225 | # spent 4µs within Log::Log4perl::Appender::layout which was called:
# once (4µs+0s) by Log::Log4perl::BEGIN@12 at line 36 of Log/Log4perl/Logger.pm | ||||
226 | # associated with this appender | ||||
227 | ########################################### | ||||
228 | 1 | 900ns | my($self, $layout) = @_; | ||
229 | |||||
230 | # Somebody wants to *set* the layout? | ||||
231 | 1 | 700ns | if($layout) { | ||
232 | $self->{layout} = $layout; | ||||
233 | |||||
234 | # somebody wants a layout, but not set yet, so give 'em default | ||||
235 | }elsif (! $self->{layout}) { | ||||
236 | $self->{layout} = Log::Log4perl::Layout::SimpleLayout | ||||
237 | ->new($self->{name}); | ||||
238 | |||||
239 | } | ||||
240 | |||||
241 | 1 | 3µs | return $self->{layout}; | ||
242 | } | ||||
243 | |||||
244 | ################################################## | ||||
245 | sub filter { # Set filter | ||||
246 | ################################################## | ||||
247 | my ($self, $filter) = @_; | ||||
248 | |||||
249 | if($filter) { | ||||
250 | print "Setting filter to $filter->{name}\n" if _INTERNAL_DEBUG; | ||||
251 | $self->{filter} = $filter; | ||||
252 | } | ||||
253 | |||||
254 | return $self->{filter}; | ||||
255 | } | ||||
256 | |||||
257 | ################################################## | ||||
258 | sub AUTOLOAD { | ||||
259 | ################################################## | ||||
260 | # Relay everything else to the underlying | ||||
261 | # Log::Log4perl::Appender::* or Log::Dispatch::* | ||||
262 | # object | ||||
263 | ################################################## | ||||
264 | my $self = shift; | ||||
265 | |||||
266 | 3 | 91µs | 2 | 23µs | # spent 15µs (7+8) within Log::Log4perl::Appender::BEGIN@266 which was called:
# once (7µs+8µs) by Log::Log4perl::Logger::BEGIN@12 at line 266 # spent 15µs making 1 call to Log::Log4perl::Appender::BEGIN@266
# spent 8µs making 1 call to strict::unimport |
267 | |||||
268 | $AUTOLOAD =~ s/.*:://; | ||||
269 | |||||
270 | if(! defined $self->{appender}) { | ||||
271 | die "Can't locate object method $AUTOLOAD() in ", __PACKAGE__; | ||||
272 | } | ||||
273 | |||||
274 | return $self->{appender}->$AUTOLOAD(@_); | ||||
275 | } | ||||
276 | |||||
277 | ################################################## | ||||
278 | sub DESTROY { | ||||
279 | ################################################## | ||||
280 | foreach my $key (keys %{$_[0]}) { | ||||
281 | # print "deleting $key\n"; | ||||
282 | delete $_[0]->{$key}; | ||||
283 | } | ||||
284 | } | ||||
285 | |||||
286 | 1 | 2µs | 1; | ||
287 | |||||
288 | __END__ | ||||
# spent 3µs within Log::Log4perl::Appender::CORE:match which was called:
# once (3µs+0s) by Log::Log4perl::Appender::new at line 44 |