| 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 | Log::Log4perl::Appender::BEGIN@10 |
| 1 | 1 | 1 | 45µs | 67µs | Log::Log4perl::Appender::new |
| 1 | 1 | 1 | 29µs | 29µs | Log::Log4perl::Appender::BEGIN@5 |
| 1 | 1 | 1 | 12µs | 31µs | Log::Log4perl::Appender::BEGIN@180 |
| 1 | 1 | 1 | 12µs | 64µs | Log::Log4perl::Appender::BEGIN@12 |
| 1 | 1 | 1 | 9µs | 66µs | Log::Log4perl::Appender::BEGIN@9 |
| 1 | 1 | 1 | 8µs | 24µs | Log::Log4perl::Appender::BEGIN@7 |
| 1 | 1 | 1 | 7µs | 12µs | Log::Log4perl::Appender::BEGIN@6 |
| 1 | 1 | 1 | 7µs | 15µs | Log::Log4perl::Appender::BEGIN@266 |
| 1 | 1 | 1 | 4µs | 4µs | Log::Log4perl::Appender::layout |
| 1 | 1 | 1 | 3µs | 3µs | Log::Log4perl::Appender::CORE:match (opcode) |
| 1 | 1 | 1 | 3µs | 3µs | Log::Log4perl::Appender::reset |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Appender::AUTOLOAD |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Appender::DESTROY |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Appender::composite |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Appender::filter |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Appender::log |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Appender::log_cached |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Appender::name |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Appender::threshold |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Appender::unique_name |
| 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 |