Profile of Log/Log4perl/Appender.pm

← 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:23:40 2012

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

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 3.47ms | 7.53ms | Log::Log4perl::Appender::::BEGIN@10Log::Log4perl::Appender::BEGIN@10
1 | 1 | 1 | 45µs | 67µs | Log::Log4perl::Appender::::newLog::Log4perl::Appender::new
1 | 1 | 1 | 29µs | 29µs | Log::Log4perl::Appender::::BEGIN@5Log::Log4perl::Appender::BEGIN@5
1 | 1 | 1 | 12µs | 31µs | Log::Log4perl::Appender::::BEGIN@180Log::Log4perl::Appender::BEGIN@180
1 | 1 | 1 | 12µs | 64µs | Log::Log4perl::Appender::::BEGIN@12Log::Log4perl::Appender::BEGIN@12
1 | 1 | 1 | 9µs | 66µs | Log::Log4perl::Appender::::BEGIN@9Log::Log4perl::Appender::BEGIN@9
1 | 1 | 1 | 8µs | 24µs | Log::Log4perl::Appender::::BEGIN@7Log::Log4perl::Appender::BEGIN@7
1 | 1 | 1 | 7µs | 12µs | Log::Log4perl::Appender::::BEGIN@6Log::Log4perl::Appender::BEGIN@6
1 | 1 | 1 | 7µs | 15µs | Log::Log4perl::Appender::::BEGIN@266Log::Log4perl::Appender::BEGIN@266
1 | 1 | 1 | 4µs | 4µs | Log::Log4perl::Appender::::layoutLog::Log4perl::Appender::layout
1 | 1 | 1 | 3µs | 3µs | Log::Log4perl::Appender::::CORE:matchLog::Log4perl::Appender::CORE:match (opcode)
1 | 1 | 1 | 3µs | 3µs | Log::Log4perl::Appender::::resetLog::Log4perl::Appender::reset
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Appender::::AUTOLOADLog::Log4perl::Appender::AUTOLOAD
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Appender::::DESTROYLog::Log4perl::Appender::DESTROY
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Appender::::compositeLog::Log4perl::Appender::composite
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Appender::::filterLog::Log4perl::Appender::filter
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Appender::::logLog::Log4perl::Appender::log
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Appender::::log_cachedLog::Log4perl::Appender::log_cached
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Appender::::nameLog::Log4perl::Appender::name
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Appender::::thresholdLog::Log4perl::Appender::threshold
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Appender::::unique_nameLog::Log4perl::Appender::unique_name

Call graph for these subroutines as a Graphviz dot language file.

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 use 5.006; # 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 use strict; # 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 use warnings; # 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 use Log::Log4perl::Level; # 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 use Log::Log4perl::Config; # 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 use constant _INTERNAL_DEBUG => 0; # 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 sub reset {
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 sub new {
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 no strict qw(refs); # 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 sub layout { # Set/Get the layout object
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 no strict qw(vars); # 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 sub Log::Log4perl::Appender::CORE:match; # opcode