| Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Log/Log4perl/Logger.pm |
| Statements | Executed 297 statements in 4.72ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 974µs | 8.74ms | Log::Log4perl::Logger::BEGIN@12 |
| 1 | 1 | 1 | 953µs | 1.47ms | Log::Log4perl::Logger::BEGIN@10 |
| 1 | 1 | 1 | 197µs | 197µs | Log::Log4perl::Logger::BEGIN@13 |
| 1 | 1 | 1 | 184µs | 7.95ms | Log::Log4perl::Logger::BEGIN@11 |
| 8 | 1 | 1 | 148µs | 148µs | Log::Log4perl::Logger::create_log_level_methods |
| 1 | 1 | 1 | 87µs | 99µs | Log::Log4perl::Logger::cleanup |
| 1 | 1 | 1 | 80µs | 154µs | Log::Log4perl::Logger::set_output_methods |
| 10 | 3 | 1 | 30µs | 30µs | Log::Log4perl::Logger::generate_watch_code |
| 1 | 1 | 1 | 27µs | 27µs | Log::Log4perl::Logger::BEGIN@5 |
| 8 | 2 | 1 | 22µs | 45µs | Log::Log4perl::Logger::generate_is_xxx_coderef |
| 1 | 1 | 1 | 19µs | 174µs | Log::Log4perl::Logger::_new |
| 1 | 1 | 1 | 19µs | 198µs | Log::Log4perl::Logger::reset |
| 1 | 1 | 1 | 15µs | 20µs | Log::Log4perl::Logger::generate_coderef |
| 1 | 1 | 1 | 11µs | 31µs | Log::Log4perl::Logger::BEGIN@731 |
| 1 | 1 | 1 | 10µs | 69µs | Log::Log4perl::Logger::BEGIN@15 |
| 1 | 1 | 1 | 8µs | 11µs | Log::Log4perl::Logger::BEGIN@6 |
| 1 | 1 | 1 | 8µs | 11µs | Log::Log4perl::Logger::generate_noop_coderef |
| 1 | 1 | 1 | 8µs | 22µs | Log::Log4perl::Logger::BEGIN@7 |
| 1 | 1 | 1 | 7µs | 17µs | Log::Log4perl::Logger::BEGIN@738 |
| 1 | 1 | 1 | 7µs | 40µs | Log::Log4perl::Logger::BEGIN@20 |
| 1 | 1 | 1 | 7µs | 7µs | Log::Log4perl::Logger::BEGIN@14 |
| 1 | 1 | 1 | 7µs | 7µs | Log::Log4perl::Logger::BEGIN@9 |
| 1 | 1 | 1 | 6µs | 14µs | Log::Log4perl::Logger::BEGIN@791 |
| 1 | 1 | 1 | 6µs | 14µs | Log::Log4perl::Logger::BEGIN@760 |
| 1 | 1 | 1 | 3µs | 3µs | Log::Log4perl::Logger::DESTROY |
| 1 | 1 | 1 | 3µs | 3µs | Log::Log4perl::Logger::level |
| 1 | 1 | 1 | 2µs | 2µs | Log::Log4perl::Logger::parent_logger |
| 1 | 1 | 1 | 500ns | 500ns | Log::Log4perl::Logger::CORE:subst (opcode) |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::__ANON__[:300] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::__ANON__[:324] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::__ANON__[:347] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::__ANON__[:416] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::__ANON__[:428] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::__ANON__[:435] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::__ANON__[:773] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::__ANON__[:783] |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::add_appender |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::additivity |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::and_die |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::and_warn |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::callerline |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::create_custom_level |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::dec_level |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::eradicate_appender |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::error_die |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::error_warn |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::generate_watch_conditional |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::get_logger |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::get_root_logger |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::has_appenders |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::inc_level |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::init_warn |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::less_logging |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::log |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::logcarp |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::logcluck |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::logconfess |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::logcroak |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::logdie |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::logexit |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::logwarn |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::more_logging |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::parent_string |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::remove_appender |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::reset_all_output_methods |
| 0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::warning_render |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | ################################################## | ||||
| 2 | package Log::Log4perl::Logger; | ||||
| 3 | ################################################## | ||||
| 4 | |||||
| 5 | 3 | 36µs | 1 | 27µs | # spent 27µs within Log::Log4perl::Logger::BEGIN@5 which was called:
# once (27µs+0s) by Log::Log4perl::BEGIN@12 at line 5 # spent 27µs making 1 call to Log::Log4perl::Logger::BEGIN@5 |
| 6 | 3 | 18µs | 2 | 14µs | # spent 11µs (8+3) within Log::Log4perl::Logger::BEGIN@6 which was called:
# once (8µs+3µs) by Log::Log4perl::BEGIN@12 at line 6 # spent 11µs making 1 call to Log::Log4perl::Logger::BEGIN@6
# spent 2µs making 1 call to strict::import |
| 7 | 3 | 18µs | 2 | 37µs | # spent 22µs (8+15) within Log::Log4perl::Logger::BEGIN@7 which was called:
# once (8µs+15µs) by Log::Log4perl::BEGIN@12 at line 7 # spent 22µs making 1 call to Log::Log4perl::Logger::BEGIN@7
# spent 15µs making 1 call to warnings::import |
| 8 | |||||
| 9 | 3 | 19µs | 1 | 7µs | # spent 7µs within Log::Log4perl::Logger::BEGIN@9 which was called:
# once (7µs+0s) by Log::Log4perl::BEGIN@12 at line 9 # spent 7µs making 1 call to Log::Log4perl::Logger::BEGIN@9 |
| 10 | 3 | 78µs | 2 | 1.51ms | # spent 1.47ms (953µs+515µs) within Log::Log4perl::Logger::BEGIN@10 which was called:
# once (953µs+515µs) by Log::Log4perl::BEGIN@12 at line 10 # spent 1.47ms making 1 call to Log::Log4perl::Logger::BEGIN@10
# spent 41µs making 1 call to Log::Log4perl::Level::import |
| 11 | 3 | 97µs | 1 | 7.95ms | # spent 7.95ms (184µs+7.77) within Log::Log4perl::Logger::BEGIN@11 which was called:
# once (184µs+7.77ms) by Log::Log4perl::BEGIN@12 at line 11 # spent 7.95ms making 1 call to Log::Log4perl::Logger::BEGIN@11 |
| 12 | 3 | 95µs | 1 | 8.74ms | # spent 8.74ms (974µs+7.77) within Log::Log4perl::Logger::BEGIN@12 which was called:
# once (974µs+7.77ms) by Log::Log4perl::BEGIN@12 at line 12 # spent 8.74ms making 1 call to Log::Log4perl::Logger::BEGIN@12 |
| 13 | 3 | 203µs | 1 | 197µs | # spent 197µs within Log::Log4perl::Logger::BEGIN@13 which was called:
# once (197µs+0s) by Log::Log4perl::BEGIN@12 at line 13 # spent 197µs making 1 call to Log::Log4perl::Logger::BEGIN@13 |
| 14 | 3 | 19µs | 1 | 7µs | # spent 7µs within Log::Log4perl::Logger::BEGIN@14 which was called:
# once (7µs+0s) by Log::Log4perl::BEGIN@12 at line 14 # spent 7µs making 1 call to Log::Log4perl::Logger::BEGIN@14 |
| 15 | 3 | 34µs | 2 | 127µs | # spent 69µs (10+59) within Log::Log4perl::Logger::BEGIN@15 which was called:
# once (10µs+59µs) by Log::Log4perl::BEGIN@12 at line 15 # spent 69µs making 1 call to Log::Log4perl::Logger::BEGIN@15
# spent 58µs making 1 call to Exporter::import |
| 16 | |||||
| 17 | 1 | 1µs | $Carp::Internal{"Log::Log4perl"}++; | ||
| 18 | 1 | 1µs | $Carp::Internal{"Log::Log4perl::Logger"}++; | ||
| 19 | |||||
| 20 | 3 | 2.35ms | 2 | 72µs | # spent 40µs (7+32) within Log::Log4perl::Logger::BEGIN@20 which was called:
# once (7µs+32µs) by Log::Log4perl::BEGIN@12 at line 20 # spent 40µs making 1 call to Log::Log4perl::Logger::BEGIN@20
# spent 33µs making 1 call to constant::import |
| 21 | |||||
| 22 | # Initialization | ||||
| 23 | 1 | 200ns | our $ROOT_LOGGER; | ||
| 24 | 1 | 900ns | our $LOGGERS_BY_NAME = {}; | ||
| 25 | 1 | 2µs | our %APPENDER_BY_NAME = (); | ||
| 26 | 1 | 200ns | our $INITIALIZED = 0; | ||
| 27 | 1 | 100ns | our $NON_INIT_WARNED; | ||
| 28 | 1 | 200ns | our $DIE_DEBUG = 0; | ||
| 29 | 1 | 300ns | our $DIE_DEBUG_BUFFER = ""; | ||
| 30 | # Define the default appender that's used for formatting | ||||
| 31 | # warn/die/croak etc. messages. | ||||
| 32 | 1 | 400ns | our $STRING_APP_NAME = "_l4p_warn"; | ||
| 33 | 1 | 4µs | 1 | 67µs | our $STRING_APP = Log::Log4perl::Appender->new( # spent 67µs making 1 call to Log::Log4perl::Appender::new |
| 34 | "Log::Log4perl::Appender::String", | ||||
| 35 | name => $STRING_APP_NAME); | ||||
| 36 | 1 | 8µs | 2 | 200µs | $STRING_APP->layout(Log::Log4perl::Layout::PatternLayout->new("%m")); # spent 197µs making 1 call to Log::Log4perl::Layout::PatternLayout::new
# spent 4µs making 1 call to Log::Log4perl::Appender::layout |
| 37 | 1 | 2µs | 1 | 20µs | our $STRING_APP_CODEREF = generate_coderef([[$STRING_APP_NAME, $STRING_APP]]); # spent 20µs making 1 call to Log::Log4perl::Logger::generate_coderef |
| 38 | |||||
| 39 | 1 | 4µs | 1 | 198µs | __PACKAGE__->reset(); # spent 198µs making 1 call to Log::Log4perl::Logger::reset |
| 40 | |||||
| 41 | ########################################### | ||||
| 42 | sub warning_render { | ||||
| 43 | ########################################### | ||||
| 44 | my($logger, @message) = @_; | ||||
| 45 | |||||
| 46 | $STRING_APP->string(""); | ||||
| 47 | $STRING_APP_CODEREF->($logger, | ||||
| 48 | @message, | ||||
| 49 | Log::Log4perl::Level::to_level($ALL)); | ||||
| 50 | return $STRING_APP->string(); | ||||
| 51 | } | ||||
| 52 | |||||
| 53 | ################################################## | ||||
| 54 | # spent 99µs (87+12) within Log::Log4perl::Logger::cleanup which was called:
# once (87µs+12µs) by Log::Log4perl::END at line 5 of Log/Log4perl.pm | ||||
| 55 | ################################################## | ||||
| 56 | # warn "Logger cleanup"; | ||||
| 57 | |||||
| 58 | # Nuke all convenience loggers to avoid them causing cleanup to | ||||
| 59 | # be delayed until global destruction. Problem is that something like | ||||
| 60 | # *{"DEBUG"} = sub { $logger->debug }; | ||||
| 61 | # ties up a reference to $logger until global destruction, so we | ||||
| 62 | # need to clean up all :easy shortcuts, hence freeing the last | ||||
| 63 | # logger references, to then rely on the garbage collector for cleaning | ||||
| 64 | # up the loggers. | ||||
| 65 | 5 | 45µs | 1 | 9µs | Log::Log4perl->easy_closure_global_cleanup(); # spent 9µs making 1 call to Log::Log4perl::easy_closure_global_cleanup |
| 66 | |||||
| 67 | # Delete all loggers | ||||
| 68 | $LOGGERS_BY_NAME = {}; | ||||
| 69 | |||||
| 70 | # Delete the root logger | ||||
| 71 | undef $ROOT_LOGGER; | ||||
| 72 | |||||
| 73 | # Delete all appenders | ||||
| 74 | 1 | 33µs | 1 | 3µs | %APPENDER_BY_NAME = (); # spent 3µs making 1 call to Log::Log4perl::Logger::DESTROY |
| 75 | |||||
| 76 | undef $INITIALIZED; | ||||
| 77 | } | ||||
| 78 | |||||
| 79 | ################################################## | ||||
| 80 | # spent 3µs within Log::Log4perl::Logger::DESTROY which was called:
# once (3µs+0s) by Log::Log4perl::Logger::cleanup at line 74 | ||||
| 81 | ################################################## | ||||
| 82 | 1 | 11µs | CORE::warn "Destroying logger $_[0] ($_[0]->{category})" | ||
| 83 | if $Log::Log4perl::CHATTY_DESTROY_METHODS; | ||||
| 84 | } | ||||
| 85 | |||||
| 86 | ################################################## | ||||
| 87 | # spent 198µs (19+179) within Log::Log4perl::Logger::reset which was called:
# once (19µs+179µs) by Log::Log4perl::BEGIN@12 at line 39 | ||||
| 88 | ################################################## | ||||
| 89 | 9 | 16µs | 1 | 174µs | $ROOT_LOGGER = __PACKAGE__->_new("", $OFF); # spent 174µs making 1 call to Log::Log4perl::Logger::_new |
| 90 | # $LOGGERS_BY_NAME = {}; #leave this alone, it's used by | ||||
| 91 | #reset_all_output_methods when | ||||
| 92 | #the config changes | ||||
| 93 | |||||
| 94 | %APPENDER_BY_NAME = (); | ||||
| 95 | undef $INITIALIZED; | ||||
| 96 | undef $NON_INIT_WARNED; | ||||
| 97 | 1 | 3µs | Log::Log4perl::Appender::reset(); # spent 3µs making 1 call to Log::Log4perl::Appender::reset | ||
| 98 | |||||
| 99 | #clear out all the existing appenders | ||||
| 100 | foreach my $logger (values %$LOGGERS_BY_NAME){ | ||||
| 101 | $logger->{appender_names} = []; | ||||
| 102 | |||||
| 103 | #this next bit deals with an init_and_watch case where a category | ||||
| 104 | #is deleted from the config file, we need to zero out the existing | ||||
| 105 | #loggers so ones not in the config file not continue with their old | ||||
| 106 | #behavior --kg | ||||
| 107 | next if $logger eq $ROOT_LOGGER; | ||||
| 108 | $logger->{level} = undef; | ||||
| 109 | $logger->level(); #set it from the hierarchy | ||||
| 110 | } | ||||
| 111 | |||||
| 112 | # Clear all filters | ||||
| 113 | 1 | 3µs | Log::Log4perl::Filter::reset(); # spent 3µs making 1 call to Log::Log4perl::Filter::reset | ||
| 114 | } | ||||
| 115 | |||||
| 116 | ################################################## | ||||
| 117 | # spent 174µs (19+155) within Log::Log4perl::Logger::_new which was called:
# once (19µs+155µs) by Log::Log4perl::Logger::reset at line 89 | ||||
| 118 | ################################################## | ||||
| 119 | 12 | 20µs | my($class, $category, $level) = @_; | ||
| 120 | |||||
| 121 | print("_new: $class/$category/", defined $level ? $level : "undef", | ||||
| 122 | "\n") if _INTERNAL_DEBUG; | ||||
| 123 | |||||
| 124 | die "usage: __PACKAGE__->_new(category)" unless | ||||
| 125 | defined $category; | ||||
| 126 | |||||
| 127 | 1 | 500ns | $category =~ s/::/./g; # spent 500ns making 1 call to Log::Log4perl::Logger::CORE:subst | ||
| 128 | |||||
| 129 | # Have we created it previously? | ||||
| 130 | if(exists $LOGGERS_BY_NAME->{$category}) { | ||||
| 131 | print "_new: exists already\n" if _INTERNAL_DEBUG; | ||||
| 132 | return $LOGGERS_BY_NAME->{$category}; | ||||
| 133 | } | ||||
| 134 | |||||
| 135 | my $self = { | ||||
| 136 | category => $category, | ||||
| 137 | num_appenders => 0, | ||||
| 138 | additivity => 1, | ||||
| 139 | level => $level, | ||||
| 140 | layout => undef, | ||||
| 141 | }; | ||||
| 142 | |||||
| 143 | bless $self, $class; | ||||
| 144 | |||||
| 145 | $level ||= $self->level(); | ||||
| 146 | |||||
| 147 | # Save it in global structure | ||||
| 148 | $LOGGERS_BY_NAME->{$category} = $self; | ||||
| 149 | |||||
| 150 | 1 | 154µs | $self->set_output_methods; # spent 154µs making 1 call to Log::Log4perl::Logger::set_output_methods | ||
| 151 | |||||
| 152 | print("Created logger $self ($category)\n") if _INTERNAL_DEBUG; | ||||
| 153 | |||||
| 154 | return $self; | ||||
| 155 | } | ||||
| 156 | |||||
| 157 | ################################################## | ||||
| 158 | sub reset_all_output_methods { | ||||
| 159 | ################################################## | ||||
| 160 | print "reset_all_output_methods: \n" if _INTERNAL_DEBUG; | ||||
| 161 | |||||
| 162 | foreach my $loggername ( keys %$LOGGERS_BY_NAME){ | ||||
| 163 | $LOGGERS_BY_NAME->{$loggername}->set_output_methods; | ||||
| 164 | } | ||||
| 165 | $ROOT_LOGGER->set_output_methods; | ||||
| 166 | } | ||||
| 167 | |||||
| 168 | ################################################## | ||||
| 169 | # spent 154µs (80+74) within Log::Log4perl::Logger::set_output_methods which was called:
# once (80µs+74µs) by Log::Log4perl::Logger::_new at line 150 | ||||
| 170 | # Here's a big performance increase. Instead of having the logger | ||||
| 171 | # calculate whether to log and whom to log to every time log() is called, | ||||
| 172 | # we calculcate it once when the logger is created, and recalculate | ||||
| 173 | # it if the config information ever changes. | ||||
| 174 | # | ||||
| 175 | ################################################## | ||||
| 176 | 60 | 62µs | my ($self) = @_; | ||
| 177 | |||||
| 178 | my (@appenders, %seen); | ||||
| 179 | |||||
| 180 | 1 | 3µs | my ($level) = $self->level(); # spent 3µs making 1 call to Log::Log4perl::Logger::level | ||
| 181 | |||||
| 182 | print "set_output_methods: $self->{category}/$level\n" if _INTERNAL_DEBUG; | ||||
| 183 | |||||
| 184 | #collect the appenders in effect for this category | ||||
| 185 | |||||
| 186 | 1 | 2µs | for(my $logger = $self; $logger; $logger = parent_logger($logger)) { # spent 2µs making 1 call to Log::Log4perl::Logger::parent_logger | ||
| 187 | |||||
| 188 | foreach my $appender_name (@{$logger->{appender_names}}){ | ||||
| 189 | |||||
| 190 | #only one message per appender, (configurable) | ||||
| 191 | next if $seen{$appender_name} ++ && | ||||
| 192 | $Log::Log4perl::one_message_per_appender; | ||||
| 193 | |||||
| 194 | push (@appenders, | ||||
| 195 | [$appender_name, | ||||
| 196 | $APPENDER_BY_NAME{$appender_name}, | ||||
| 197 | ] | ||||
| 198 | ); | ||||
| 199 | } | ||||
| 200 | last unless $logger->{additivity}; | ||||
| 201 | } | ||||
| 202 | |||||
| 203 | #make a no-op coderef for inactive levels | ||||
| 204 | 1 | 11µs | my $noop = generate_noop_coderef(); # spent 11µs making 1 call to Log::Log4perl::Logger::generate_noop_coderef | ||
| 205 | |||||
| 206 | #make a coderef | ||||
| 207 | my $coderef = (! @appenders ? $noop : &generate_coderef(\@appenders)); | ||||
| 208 | |||||
| 209 | my %priority = %Log::Log4perl::Level::PRIORITY; #convenience and cvs | ||||
| 210 | |||||
| 211 | # changed to >= from <= as level ints were reversed | ||||
| 212 | foreach my $levelname (keys %priority){ | ||||
| 213 | 8 | 14µs | if (Log::Log4perl::Level::isGreaterOrEqual($level, # spent 14µs making 8 calls to Log::Log4perl::Level::isGreaterOrEqual, avg 2µs/call | ||
| 214 | $priority{$levelname} | ||||
| 215 | )) { | ||||
| 216 | print " ($priority{$levelname} <= $level)\n" | ||||
| 217 | if _INTERNAL_DEBUG; | ||||
| 218 | $self->{$levelname} = $coderef; | ||||
| 219 | 1 | 4µs | $self->{"is_$levelname"} = generate_is_xxx_coderef("1"); # spent 4µs making 1 call to Log::Log4perl::Logger::generate_is_xxx_coderef | ||
| 220 | print "Setting is_$levelname to 1\n" if _INTERNAL_DEBUG; | ||||
| 221 | }else{ | ||||
| 222 | print " ($priority{$levelname} > $level)\n" if _INTERNAL_DEBUG; | ||||
| 223 | $self->{$levelname} = $noop; | ||||
| 224 | 7 | 41µs | $self->{"is_$levelname"} = generate_is_xxx_coderef("0"); # spent 41µs making 7 calls to Log::Log4perl::Logger::generate_is_xxx_coderef, avg 6µs/call | ||
| 225 | print "Setting is_$levelname to 0\n" if _INTERNAL_DEBUG; | ||||
| 226 | } | ||||
| 227 | |||||
| 228 | print(" Setting [$self] $self->{category}.$levelname to ", | ||||
| 229 | ($self->{$levelname} == $noop ? "NOOP" : | ||||
| 230 | ("Coderef [$coderef]: " . scalar @appenders . " appenders")), | ||||
| 231 | "\n") if _INTERNAL_DEBUG; | ||||
| 232 | } | ||||
| 233 | } | ||||
| 234 | |||||
| 235 | ################################################## | ||||
| 236 | # spent 20µs (15+5) within Log::Log4perl::Logger::generate_coderef which was called:
# once (15µs+5µs) by Log::Log4perl::BEGIN@12 at line 37 | ||||
| 237 | ################################################## | ||||
| 238 | 4 | 12µs | my $appenders = shift; | ||
| 239 | |||||
| 240 | print "generate_coderef: ", scalar @$appenders, | ||||
| 241 | " appenders\n" if _INTERNAL_DEBUG; | ||||
| 242 | |||||
| 243 | 1 | 5µs | my $watch_check_code = generate_watch_code("logger", 1); # spent 5µs making 1 call to Log::Log4perl::Logger::generate_watch_code | ||
| 244 | |||||
| 245 | return sub { | ||||
| 246 | my $logger = shift; | ||||
| 247 | my $level = pop; | ||||
| 248 | |||||
| 249 | my $message; | ||||
| 250 | my $appenders_fired = 0; | ||||
| 251 | |||||
| 252 | # Evaluate all parameters that need to be evaluated. Two kinds: | ||||
| 253 | # | ||||
| 254 | # (1) It's a hash like { filter => "filtername", | ||||
| 255 | # value => "value" } | ||||
| 256 | # => filtername(value) | ||||
| 257 | # | ||||
| 258 | # (2) It's a code ref | ||||
| 259 | # => coderef() | ||||
| 260 | # | ||||
| 261 | |||||
| 262 | $message = [map { ref $_ eq "HASH" && | ||||
| 263 | exists $_->{filter} && | ||||
| 264 | ref $_->{filter} eq 'CODE' ? | ||||
| 265 | $_->{filter}->($_->{value}) : | ||||
| 266 | ref $_ eq "CODE" ? | ||||
| 267 | $_->() : $_ | ||||
| 268 | } @_]; | ||||
| 269 | |||||
| 270 | print("coderef: $logger->{category}\n") if _INTERNAL_DEBUG; | ||||
| 271 | |||||
| 272 | if(defined $Log::Log4perl::Config::WATCHER) { | ||||
| 273 | return unless $watch_check_code->($logger, @_, $level); | ||||
| 274 | } | ||||
| 275 | |||||
| 276 | foreach my $a (@$appenders) { #note the closure here | ||||
| 277 | my ($appender_name, $appender) = @$a; | ||||
| 278 | |||||
| 279 | print(" Sending message '<$message->[0]>' ($level) " . | ||||
| 280 | "to $appender_name\n") if _INTERNAL_DEBUG; | ||||
| 281 | |||||
| 282 | $appender->log( | ||||
| 283 | #these get passed through to Log::Dispatch | ||||
| 284 | { name => $appender_name, | ||||
| 285 | level => $Log::Log4perl::Level::L4P_TO_LD{ | ||||
| 286 | $level}, | ||||
| 287 | message => $message, | ||||
| 288 | }, | ||||
| 289 | #these we need | ||||
| 290 | $logger->{category}, | ||||
| 291 | $level, | ||||
| 292 | ) and $appenders_fired++; | ||||
| 293 | # Only counting it if it returns a true value. Otherwise | ||||
| 294 | # the appender threshold might have suppressed it after all. | ||||
| 295 | |||||
| 296 | } #end foreach appenders | ||||
| 297 | |||||
| 298 | return $appenders_fired; | ||||
| 299 | |||||
| 300 | }; #end coderef | ||||
| 301 | } | ||||
| 302 | |||||
| 303 | ################################################## | ||||
| 304 | # spent 11µs (8+2) within Log::Log4perl::Logger::generate_noop_coderef which was called:
# once (8µs+2µs) by Log::Log4perl::Logger::set_output_methods at line 204 | ||||
| 305 | ################################################## | ||||
| 306 | 6 | 8µs | my $watch_delay_code; | ||
| 307 | |||||
| 308 | # This might seem crazy at first, but even in a Log4perl noop, we | ||||
| 309 | # need to check if the configuration changed in a init_and_watch | ||||
| 310 | # situation. Why? Say, an application is running in a loop that | ||||
| 311 | # constantly tries to issue debug() messages, but they're suppressed by | ||||
| 312 | # the current Log4perl configuration. If debug() (which is a noop | ||||
| 313 | # here) wasn't watching the configuration for changes, it would never | ||||
| 314 | # catch the case where someone bumps up the log level and expects | ||||
| 315 | # the application to pick it up and start logging debug() statements. | ||||
| 316 | |||||
| 317 | 1 | 2µs | my $watch_check_code = generate_watch_code("logger", 1); # spent 2µs making 1 call to Log::Log4perl::Logger::generate_watch_code | ||
| 318 | |||||
| 319 | my $coderef; | ||||
| 320 | |||||
| 321 | if(defined $Log::Log4perl::Config::WATCHER) { | ||||
| 322 | $coderef = $watch_check_code; | ||||
| 323 | } else { | ||||
| 324 | $coderef = sub { undef }; | ||||
| 325 | } | ||||
| 326 | |||||
| 327 | return $coderef; | ||||
| 328 | } | ||||
| 329 | |||||
| 330 | ################################################## | ||||
| 331 | sub generate_is_xxx_coderef { | ||||
| 332 | ################################################## | ||||
| 333 | 16 | 22µs | my($return_token) = @_; | ||
| 334 | |||||
| 335 | 8 | 22µs | return generate_watch_code("checker", $return_token); # spent 22µs making 8 calls to Log::Log4perl::Logger::generate_watch_code, avg 3µs/call | ||
| 336 | } | ||||
| 337 | |||||
| 338 | ################################################## | ||||
| 339 | # spent 30µs within Log::Log4perl::Logger::generate_watch_code which was called 10 times, avg 3µs/call:
# 8 times (22µs+0s) by Log::Log4perl::Logger::generate_is_xxx_coderef at line 335, avg 3µs/call
# once (5µs+0s) by Log::Log4perl::Logger::generate_coderef at line 243
# once (2µs+0s) by Log::Log4perl::Logger::generate_noop_coderef at line 317 | ||||
| 340 | ################################################## | ||||
| 341 | 30 | 45µs | my($type, $return_token) = @_; | ||
| 342 | |||||
| 343 | print "generate_watch_code:\n" if _INTERNAL_DEBUG; | ||||
| 344 | |||||
| 345 | # No watcher configured, return a no-op as watch code. | ||||
| 346 | if(! defined $Log::Log4perl::Config::WATCHER) { | ||||
| 347 | return sub { $return_token }; | ||||
| 348 | } | ||||
| 349 | |||||
| 350 | my $cond = generate_watch_conditional(); | ||||
| 351 | |||||
| 352 | return sub { | ||||
| 353 | print "exe_watch_code:\n" if _INTERNAL_DEBUG; | ||||
| 354 | |||||
| 355 | if(_INTERNAL_DEBUG) { | ||||
| 356 | print "Next check: ", | ||||
| 357 | "$Log::Log4perl::Config::Watch::NEXT_CHECK_TIME ", | ||||
| 358 | " Now: ", time(), " Mod: ", | ||||
| 359 | (stat($Log::Log4perl::Config::WATCHER->file()))[9], | ||||
| 360 | "\n"; | ||||
| 361 | } | ||||
| 362 | |||||
| 363 | if( $cond->() ) { | ||||
| 364 | my $init_permitted = 1; | ||||
| 365 | |||||
| 366 | if(exists $Log::Log4perl::Config::OPTS->{ preinit_callback } ) { | ||||
| 367 | print "Calling preinit_callback\n" if _INTERNAL_DEBUG; | ||||
| 368 | $init_permitted = | ||||
| 369 | $Log::Log4perl::Config::OPTS->{ preinit_callback }->( | ||||
| 370 | Log::Log4perl::Config->watcher()->file() ); | ||||
| 371 | print "Callback returned $init_permitted\n" if _INTERNAL_DEBUG; | ||||
| 372 | } | ||||
| 373 | |||||
| 374 | if( $init_permitted ) { | ||||
| 375 | Log::Log4perl->init_and_watch(); | ||||
| 376 | } else { | ||||
| 377 | # It was time to reinit, but init wasn't permitted. | ||||
| 378 | # Return true, so that the logger continues as if | ||||
| 379 | # it wasn't time to reinit. | ||||
| 380 | return 1; | ||||
| 381 | } | ||||
| 382 | |||||
| 383 | my $logger = shift; | ||||
| 384 | my $level = pop; | ||||
| 385 | |||||
| 386 | # Forward call to new configuration | ||||
| 387 | if($type eq "checker") { | ||||
| 388 | return $logger->$level(); | ||||
| 389 | |||||
| 390 | } elsif( $type eq "logger") { | ||||
| 391 | my $methodname = lc($level); | ||||
| 392 | |||||
| 393 | # Bump up the caller level by three, since | ||||
| 394 | # we've artifically introduced additional levels. | ||||
| 395 | local $Log::Log4perl::caller_depth = | ||||
| 396 | $Log::Log4perl::caller_depth + 3; | ||||
| 397 | |||||
| 398 | # Get a new logger for the same category (the old | ||||
| 399 | # logger might be obsolete because of the re-init) | ||||
| 400 | $logger = Log::Log4perl::get_logger( $logger->{category} ); | ||||
| 401 | |||||
| 402 | $logger->$methodname(@_); # send the message | ||||
| 403 | # to the new configuration | ||||
| 404 | return undef; # Return false, so the logger finishes | ||||
| 405 | # prematurely and doesn't log the same | ||||
| 406 | # message again. | ||||
| 407 | } else { | ||||
| 408 | die "internal error: unknown type"; | ||||
| 409 | } | ||||
| 410 | } else { | ||||
| 411 | if(_INTERNAL_DEBUG) { | ||||
| 412 | print "Conditional returned false\n"; | ||||
| 413 | } | ||||
| 414 | return $return_token; | ||||
| 415 | } | ||||
| 416 | }; | ||||
| 417 | } | ||||
| 418 | |||||
| 419 | ################################################## | ||||
| 420 | sub generate_watch_conditional { | ||||
| 421 | ################################################## | ||||
| 422 | |||||
| 423 | if(defined $Log::Log4perl::Config::Watch::SIGNAL_CAUGHT) { | ||||
| 424 | # In this mode, we just check for the variable indicating | ||||
| 425 | # that the signal has been caught | ||||
| 426 | return sub { | ||||
| 427 | return $Log::Log4perl::Config::Watch::SIGNAL_CAUGHT; | ||||
| 428 | }; | ||||
| 429 | } | ||||
| 430 | |||||
| 431 | return sub { | ||||
| 432 | return | ||||
| 433 | ( time() > $Log::Log4perl::Config::Watch::NEXT_CHECK_TIME and | ||||
| 434 | $Log::Log4perl::Config::WATCHER->change_detected() ); | ||||
| 435 | }; | ||||
| 436 | } | ||||
| 437 | |||||
| 438 | ################################################## | ||||
| 439 | sub parent_string { | ||||
| 440 | ################################################## | ||||
| 441 | my($string) = @_; | ||||
| 442 | |||||
| 443 | if($string eq "") { | ||||
| 444 | return undef; # root doesn't have a parent. | ||||
| 445 | } | ||||
| 446 | |||||
| 447 | my @components = split /\./, $string; | ||||
| 448 | |||||
| 449 | if(@components == 1) { | ||||
| 450 | return ""; | ||||
| 451 | } | ||||
| 452 | |||||
| 453 | pop @components; | ||||
| 454 | |||||
| 455 | return join('.', @components); | ||||
| 456 | } | ||||
| 457 | |||||
| 458 | ################################################## | ||||
| 459 | # spent 3µs within Log::Log4perl::Logger::level which was called:
# once (3µs+0s) by Log::Log4perl::Logger::set_output_methods at line 180 | ||||
| 460 | ################################################## | ||||
| 461 | 3 | 5µs | my($self, $level, $dont_reset_all) = @_; | ||
| 462 | |||||
| 463 | # 'Set' function | ||||
| 464 | if(defined $level) { | ||||
| 465 | croak "invalid level '$level'" | ||||
| 466 | unless Log::Log4perl::Level::is_valid($level); | ||||
| 467 | if ($level =~ /\D/){ | ||||
| 468 | $level = Log::Log4perl::Level::to_priority($level); | ||||
| 469 | } | ||||
| 470 | $self->{level} = $level; | ||||
| 471 | |||||
| 472 | &reset_all_output_methods | ||||
| 473 | unless $dont_reset_all; #keep us from getting overworked | ||||
| 474 | #if it's the config file calling us | ||||
| 475 | |||||
| 476 | return $level; | ||||
| 477 | } | ||||
| 478 | |||||
| 479 | # 'Get' function | ||||
| 480 | if(defined $self->{level}) { | ||||
| 481 | return $self->{level}; | ||||
| 482 | } | ||||
| 483 | |||||
| 484 | for(my $logger = $self; $logger; $logger = parent_logger($logger)) { | ||||
| 485 | |||||
| 486 | # Does the current logger have the level defined? | ||||
| 487 | |||||
| 488 | if($logger->{category} eq "") { | ||||
| 489 | # It's the root logger | ||||
| 490 | return $ROOT_LOGGER->{level}; | ||||
| 491 | } | ||||
| 492 | |||||
| 493 | if(defined $LOGGERS_BY_NAME->{$logger->{category}}->{level}) { | ||||
| 494 | return $LOGGERS_BY_NAME->{$logger->{category}}->{level}; | ||||
| 495 | } | ||||
| 496 | } | ||||
| 497 | |||||
| 498 | # We should never get here because at least the root logger should | ||||
| 499 | # have a level defined | ||||
| 500 | die "We should never get here."; | ||||
| 501 | } | ||||
| 502 | |||||
| 503 | ################################################## | ||||
| 504 | # spent 2µs within Log::Log4perl::Logger::parent_logger which was called:
# once (2µs+0s) by Log::Log4perl::Logger::set_output_methods at line 186 | ||||
| 505 | # Get the parent of the current logger or undef | ||||
| 506 | ################################################## | ||||
| 507 | 2 | 4µs | my($logger) = @_; | ||
| 508 | |||||
| 509 | # Is it the root logger? | ||||
| 510 | if($logger->{category} eq "") { | ||||
| 511 | # Root has no parent | ||||
| 512 | return undef; | ||||
| 513 | } | ||||
| 514 | |||||
| 515 | # Go to the next defined (!) parent | ||||
| 516 | my $parent_class = parent_string($logger->{category}); | ||||
| 517 | |||||
| 518 | while($parent_class ne "" and | ||||
| 519 | ! exists $LOGGERS_BY_NAME->{$parent_class}) { | ||||
| 520 | $parent_class = parent_string($parent_class); | ||||
| 521 | $logger = $LOGGERS_BY_NAME->{$parent_class}; | ||||
| 522 | } | ||||
| 523 | |||||
| 524 | if($parent_class eq "") { | ||||
| 525 | $logger = $ROOT_LOGGER; | ||||
| 526 | } else { | ||||
| 527 | $logger = $LOGGERS_BY_NAME->{$parent_class}; | ||||
| 528 | } | ||||
| 529 | |||||
| 530 | return $logger; | ||||
| 531 | } | ||||
| 532 | |||||
| 533 | ################################################## | ||||
| 534 | sub get_root_logger { | ||||
| 535 | ################################################## | ||||
| 536 | my($class) = @_; | ||||
| 537 | return $ROOT_LOGGER; | ||||
| 538 | } | ||||
| 539 | |||||
| 540 | ################################################## | ||||
| 541 | sub additivity { | ||||
| 542 | ################################################## | ||||
| 543 | my($self, $onoff) = @_; | ||||
| 544 | |||||
| 545 | if(defined $onoff) { | ||||
| 546 | $self->{additivity} = $onoff; | ||||
| 547 | } | ||||
| 548 | |||||
| 549 | return $self->{additivity}; | ||||
| 550 | } | ||||
| 551 | |||||
| 552 | ################################################## | ||||
| 553 | sub get_logger { | ||||
| 554 | ################################################## | ||||
| 555 | my($class, $category) = @_; | ||||
| 556 | |||||
| 557 | unless(defined $ROOT_LOGGER) { | ||||
| 558 | die "Internal error: Root Logger not initialized."; | ||||
| 559 | } | ||||
| 560 | |||||
| 561 | return $ROOT_LOGGER if $category eq ""; | ||||
| 562 | |||||
| 563 | my $logger = $class->_new($category); | ||||
| 564 | return $logger; | ||||
| 565 | } | ||||
| 566 | |||||
| 567 | ################################################## | ||||
| 568 | sub add_appender { | ||||
| 569 | ################################################## | ||||
| 570 | my($self, $appender, $dont_reset_all) = @_; | ||||
| 571 | |||||
| 572 | # We take this as an indicator that we're initialized. | ||||
| 573 | $INITIALIZED = 1; | ||||
| 574 | |||||
| 575 | my $appender_name = $appender->name(); | ||||
| 576 | |||||
| 577 | $self->{num_appenders}++; #should this be inside the unless? | ||||
| 578 | |||||
| 579 | # Add newly created appender to the end of the appender array | ||||
| 580 | unless (grep{$_ eq $appender_name} @{$self->{appender_names}}){ | ||||
| 581 | $self->{appender_names} = [sort @{$self->{appender_names}}, | ||||
| 582 | $appender_name]; | ||||
| 583 | } | ||||
| 584 | |||||
| 585 | $APPENDER_BY_NAME{$appender_name} = $appender; | ||||
| 586 | |||||
| 587 | reset_all_output_methods | ||||
| 588 | unless $dont_reset_all; # keep us from getting overworked | ||||
| 589 | # if it's the config file calling us | ||||
| 590 | |||||
| 591 | # For chaining calls ... | ||||
| 592 | return $appender; | ||||
| 593 | } | ||||
| 594 | |||||
| 595 | ################################################## | ||||
| 596 | sub remove_appender { | ||||
| 597 | ################################################## | ||||
| 598 | my($self, $appender_name, $dont_reset_all, $sloppy) = @_; | ||||
| 599 | |||||
| 600 | my %appender_names = map { $_ => 1 } @{$self->{appender_names}}; | ||||
| 601 | |||||
| 602 | if(!exists $appender_names{$appender_name}) { | ||||
| 603 | die "No such appender: $appender_name" unless $sloppy; | ||||
| 604 | return undef; | ||||
| 605 | } | ||||
| 606 | |||||
| 607 | delete $appender_names{$appender_name}; | ||||
| 608 | $self->{num_appenders}--; | ||||
| 609 | $self->{appender_names} = [sort keys %appender_names]; | ||||
| 610 | |||||
| 611 | &reset_all_output_methods | ||||
| 612 | unless $dont_reset_all; | ||||
| 613 | } | ||||
| 614 | |||||
| 615 | ################################################## | ||||
| 616 | sub eradicate_appender { | ||||
| 617 | ################################################## | ||||
| 618 | # If someone calls Logger->... and not Logger::... | ||||
| 619 | shift if $_[0] eq __PACKAGE__; | ||||
| 620 | |||||
| 621 | my($appender_name, $dont_reset_all) = @_; | ||||
| 622 | |||||
| 623 | return 0 unless exists | ||||
| 624 | $APPENDER_BY_NAME{$appender_name}; | ||||
| 625 | |||||
| 626 | # Remove the given appender from all loggers | ||||
| 627 | # and delete all references to it, causing | ||||
| 628 | # its DESTROY method to be called. | ||||
| 629 | foreach my $logger (values %$LOGGERS_BY_NAME){ | ||||
| 630 | $logger->remove_appender($appender_name, 0, 1); | ||||
| 631 | } | ||||
| 632 | # Also remove it from the root logger | ||||
| 633 | $ROOT_LOGGER->remove_appender($appender_name, 0, 1); | ||||
| 634 | |||||
| 635 | delete $APPENDER_BY_NAME{$appender_name}; | ||||
| 636 | |||||
| 637 | &reset_all_output_methods | ||||
| 638 | unless $dont_reset_all; | ||||
| 639 | |||||
| 640 | return 1; | ||||
| 641 | } | ||||
| 642 | |||||
| 643 | ################################################## | ||||
| 644 | sub has_appenders { | ||||
| 645 | ################################################## | ||||
| 646 | my($self) = @_; | ||||
| 647 | |||||
| 648 | return $self->{num_appenders}; | ||||
| 649 | } | ||||
| 650 | |||||
| 651 | ################################################## | ||||
| 652 | sub log { | ||||
| 653 | # external api | ||||
| 654 | ################################################## | ||||
| 655 | my ($self, $priority, @messages) = @_; | ||||
| 656 | |||||
| 657 | confess("log: No priority given!") unless defined($priority); | ||||
| 658 | |||||
| 659 | # Just in case of 'init_and_watch' -- see Changes 0.21 | ||||
| 660 | $_[0] = $LOGGERS_BY_NAME->{$_[0]->{category}} if | ||||
| 661 | defined $Log::Log4perl::Config::WATCHER; | ||||
| 662 | |||||
| 663 | init_warn() unless $INITIALIZED or $NON_INIT_WARNED; | ||||
| 664 | |||||
| 665 | croak "priority $priority isn't numeric" if ($priority =~ /\D/); | ||||
| 666 | |||||
| 667 | my $which = Log::Log4perl::Level::to_level($priority); | ||||
| 668 | |||||
| 669 | $self->{$which}->($self, @messages, | ||||
| 670 | Log::Log4perl::Level::to_level($priority)); | ||||
| 671 | } | ||||
| 672 | |||||
| 673 | ###################################################################### | ||||
| 674 | # | ||||
| 675 | # create_custom_level | ||||
| 676 | # creates a custom level | ||||
| 677 | # in theory, could be used to create the default ones | ||||
| 678 | ###################################################################### | ||||
| 679 | sub create_custom_level { | ||||
| 680 | ###################################################################### | ||||
| 681 | my $level = shift || die("create_custom_level: " . | ||||
| 682 | "forgot to pass in a level string!"); | ||||
| 683 | my $after = shift || die("create_custom_level: " . | ||||
| 684 | "forgot to pass in a level after which to " . | ||||
| 685 | "place the new level!"); | ||||
| 686 | my $syslog_equiv = shift; # can be undef | ||||
| 687 | my $log_dispatch_level = shift; # optional | ||||
| 688 | |||||
| 689 | ## only let users create custom levels before initialization | ||||
| 690 | |||||
| 691 | die("create_custom_level must be called before init or " . | ||||
| 692 | "first get_logger() call") if ($INITIALIZED); | ||||
| 693 | |||||
| 694 | my %PRIORITY = %Log::Log4perl::Level::PRIORITY; #convenience | ||||
| 695 | |||||
| 696 | die("create_custom_level: no such level \"$after\"! Use one of: ", | ||||
| 697 | join(", ", sort keys %PRIORITY)) unless $PRIORITY{$after}; | ||||
| 698 | |||||
| 699 | # figure out new int value by AFTER + (AFTER+ 1) / 2 | ||||
| 700 | |||||
| 701 | my $next_prio = Log::Log4perl::Level::get_lower_level($PRIORITY{$after}, 1); | ||||
| 702 | my $cust_prio = int(($PRIORITY{$after} + $next_prio) / 2); | ||||
| 703 | |||||
| 704 | die(qq{create_custom_level: Calculated level of $cust_prio already exists! | ||||
| 705 | This should only happen if you've made some insane number of custom | ||||
| 706 | levels (like 15 one after another) | ||||
| 707 | You can usually fix this by re-arranging your code from: | ||||
| 708 | create_custom_level("cust1", X); | ||||
| 709 | create_custom_level("cust2", X); | ||||
| 710 | create_custom_level("cust3", X); | ||||
| 711 | create_custom_level("cust4", X); | ||||
| 712 | create_custom_level("cust5", X); | ||||
| 713 | into: | ||||
| 714 | create_custom_level("cust3", X); | ||||
| 715 | create_custom_level("cust5", X); | ||||
| 716 | create_custom_level("cust4", 4); | ||||
| 717 | create_custom_level("cust2", cust3); | ||||
| 718 | create_custom_level("cust1", cust2); | ||||
| 719 | }) if (${Log::Log4perl::Level::LEVELS{$cust_prio}}); | ||||
| 720 | |||||
| 721 | Log::Log4perl::Level::add_priority($level, $cust_prio, $syslog_equiv, | ||||
| 722 | $log_dispatch_level); | ||||
| 723 | |||||
| 724 | print("Adding prio $level at $cust_prio\n") if _INTERNAL_DEBUG; | ||||
| 725 | |||||
| 726 | # get $LEVEL into namespace of Log::Log4perl::Logger to | ||||
| 727 | # create $logger->foo nd $logger->is_foo | ||||
| 728 | my $name = "Log::Log4perl::Logger::"; | ||||
| 729 | my $key = $level; | ||||
| 730 | |||||
| 731 | 3 | 52µs | 2 | 51µs | # spent 31µs (11+20) within Log::Log4perl::Logger::BEGIN@731 which was called:
# once (11µs+20µs) by Log::Log4perl::BEGIN@12 at line 731 # spent 31µs making 1 call to Log::Log4perl::Logger::BEGIN@731
# spent 20µs making 1 call to strict::unimport |
| 732 | # be sure to use ${Log...} as CVS adds log entries for Log | ||||
| 733 | *{"$name$key"} = \${Log::Log4perl::Level::PRIORITY{$level}}; | ||||
| 734 | |||||
| 735 | # now, stick it in the caller's namespace | ||||
| 736 | $name = caller(0) . "::"; | ||||
| 737 | *{"$name$key"} = \${Log::Log4perl::Level::PRIORITY{$level}}; | ||||
| 738 | 3 | 84µs | 2 | 26µs | # spent 17µs (7+10) within Log::Log4perl::Logger::BEGIN@738 which was called:
# once (7µs+10µs) by Log::Log4perl::BEGIN@12 at line 738 # spent 17µs making 1 call to Log::Log4perl::Logger::BEGIN@738
# spent 10µs making 1 call to strict::import |
| 739 | |||||
| 740 | create_log_level_methods($level); | ||||
| 741 | |||||
| 742 | return 0; | ||||
| 743 | |||||
| 744 | } | ||||
| 745 | |||||
| 746 | ######################################## | ||||
| 747 | # | ||||
| 748 | # if we were hackin' lisp (or scheme), we'd be returning some lambda | ||||
| 749 | # expressions. But we aren't. :) So we'll just create some strings and | ||||
| 750 | # eval them. | ||||
| 751 | ######################################## | ||||
| 752 | # spent 148µs within Log::Log4perl::Logger::create_log_level_methods which was called 8 times, avg 18µs/call:
# 8 times (148µs+0s) by Log::Log4perl::BEGIN@12 at line 798, avg 18µs/call | ||||
| 753 | ######################################## | ||||
| 754 | 80 | 158µs | my $level = shift || die("create_log_level_methods: " . | ||
| 755 | "forgot to pass in a level string!"); | ||||
| 756 | my $lclevel = lc($level); | ||||
| 757 | my $levelint = uc($level) . "_INT"; | ||||
| 758 | my $initial_cap = ucfirst($lclevel); | ||||
| 759 | |||||
| 760 | 3 | 174µs | 2 | 22µs | # spent 14µs (6+8) within Log::Log4perl::Logger::BEGIN@760 which was called:
# once (6µs+8µs) by Log::Log4perl::BEGIN@12 at line 760 # spent 14µs making 1 call to Log::Log4perl::Logger::BEGIN@760
# spent 8µs making 1 call to strict::unimport |
| 761 | |||||
| 762 | # This is a bit better way to create code on the fly than eval'ing strings. | ||||
| 763 | # -erik | ||||
| 764 | |||||
| 765 | *{__PACKAGE__ . "::$lclevel"} = sub { | ||||
| 766 | if(_INTERNAL_DEBUG) { | ||||
| 767 | my $level_disp = (defined $_[0]->{level} ? $_[0]->{level} | ||||
| 768 | : "[undef]"); | ||||
| 769 | print "$lclevel: ($_[0]->{category}/$level_disp) [@_]\n"; | ||||
| 770 | } | ||||
| 771 | init_warn() unless $INITIALIZED or $NON_INIT_WARNED; | ||||
| 772 | $_[0]->{$level}->(@_, $level) if defined $_[0]->{$level}; | ||||
| 773 | }; | ||||
| 774 | |||||
| 775 | # Added these to have is_xxx functions as fast as xxx functions | ||||
| 776 | # -ms | ||||
| 777 | |||||
| 778 | my $islevel = "is_" . $level; | ||||
| 779 | my $islclevel = "is_" . $lclevel; | ||||
| 780 | |||||
| 781 | *{__PACKAGE__ . "::is_$lclevel"} = sub { | ||||
| 782 | $_[0]->{$islevel}->($_[0], $islclevel); | ||||
| 783 | }; | ||||
| 784 | |||||
| 785 | # Add the isXxxEnabled() methods as identical to the is_xxx | ||||
| 786 | # functions. - dviner | ||||
| 787 | |||||
| 788 | *{__PACKAGE__ . "::is".$initial_cap."Enabled"} = | ||||
| 789 | \&{__PACKAGE__ . "::is_$lclevel"}; | ||||
| 790 | |||||
| 791 | 3 | 941µs | 2 | 21µs | # spent 14µs (6+8) within Log::Log4perl::Logger::BEGIN@791 which was called:
# once (6µs+8µs) by Log::Log4perl::BEGIN@12 at line 791 # spent 14µs making 1 call to Log::Log4perl::Logger::BEGIN@791
# spent 8µs making 1 call to strict::import |
| 792 | |||||
| 793 | return 0; | ||||
| 794 | } | ||||
| 795 | |||||
| 796 | #now lets autogenerate the logger subs based on the defined priorities | ||||
| 797 | 1 | 2µs | foreach my $level (keys %Log::Log4perl::Level::PRIORITY){ | ||
| 798 | 8 | 15µs | 8 | 148µs | create_log_level_methods($level); # spent 148µs making 8 calls to Log::Log4perl::Logger::create_log_level_methods, avg 18µs/call |
| 799 | } | ||||
| 800 | |||||
| 801 | ################################################## | ||||
| 802 | sub init_warn { | ||||
| 803 | ################################################## | ||||
| 804 | CORE::warn "Log4perl: Seems like no initialization happened. " . | ||||
| 805 | "Forgot to call init()?\n"; | ||||
| 806 | # Only tell this once; | ||||
| 807 | $NON_INIT_WARNED = 1; | ||||
| 808 | } | ||||
| 809 | |||||
| 810 | ####################################################### | ||||
| 811 | # call me from a sub-func to spew the sub-func's caller | ||||
| 812 | ####################################################### | ||||
| 813 | sub callerline { | ||||
| 814 | my $message = join ('', @_); | ||||
| 815 | |||||
| 816 | my ($pack, $file, $line) = caller($Log::Log4perl::caller_depth + 1); | ||||
| 817 | |||||
| 818 | if (not chomp $message) { # no newline | ||||
| 819 | $message .= " at $file line $line"; | ||||
| 820 | |||||
| 821 | # Someday, we'll use Threads. Really. | ||||
| 822 | if (defined &Thread::tid) { | ||||
| 823 | my $tid = Thread->self->tid; | ||||
| 824 | $message .= " thread $tid" if $tid; | ||||
| 825 | } | ||||
| 826 | } | ||||
| 827 | |||||
| 828 | return ($message, "\n"); | ||||
| 829 | } | ||||
| 830 | |||||
| 831 | ####################################################### | ||||
| 832 | sub and_warn { | ||||
| 833 | ####################################################### | ||||
| 834 | my $self = shift; | ||||
| 835 | CORE::warn(callerline($self->warning_render(@_))); | ||||
| 836 | } | ||||
| 837 | |||||
| 838 | ####################################################### | ||||
| 839 | sub and_die { | ||||
| 840 | ####################################################### | ||||
| 841 | my $self = shift; | ||||
| 842 | |||||
| 843 | my($msg) = callerline($self->warning_render(@_)); | ||||
| 844 | |||||
| 845 | if($DIE_DEBUG) { | ||||
| 846 | $DIE_DEBUG_BUFFER = "DIE_DEBUG: $msg"; | ||||
| 847 | } else { | ||||
| 848 | die("$msg\n"); | ||||
| 849 | } | ||||
| 850 | } | ||||
| 851 | |||||
| 852 | ################################################## | ||||
| 853 | sub logwarn { | ||||
| 854 | ################################################## | ||||
| 855 | my $self = shift; | ||||
| 856 | |||||
| 857 | local $Log::Log4perl::caller_depth = | ||||
| 858 | $Log::Log4perl::caller_depth + 1; | ||||
| 859 | |||||
| 860 | if ($self->is_warn()) { | ||||
| 861 | # Since we're one caller level off now, compensate for that. | ||||
| 862 | my @chomped = @_; | ||||
| 863 | chomp($chomped[-1]); | ||||
| 864 | $self->warn(@chomped); | ||||
| 865 | } | ||||
| 866 | |||||
| 867 | $self->and_warn(@_); | ||||
| 868 | } | ||||
| 869 | |||||
| 870 | ################################################## | ||||
| 871 | sub logdie { | ||||
| 872 | ################################################## | ||||
| 873 | my $self = shift; | ||||
| 874 | |||||
| 875 | local $Log::Log4perl::caller_depth = | ||||
| 876 | $Log::Log4perl::caller_depth + 1; | ||||
| 877 | |||||
| 878 | if ($self->is_fatal()) { | ||||
| 879 | # Since we're one caller level off now, compensate for that. | ||||
| 880 | my @chomped = @_; | ||||
| 881 | chomp($chomped[-1]); | ||||
| 882 | $self->fatal(@chomped); | ||||
| 883 | } | ||||
| 884 | |||||
| 885 | $Log::Log4perl::LOGDIE_MESSAGE_ON_STDERR ? | ||||
| 886 | $self->and_die(@_) : | ||||
| 887 | exit($Log::Log4perl::LOGEXIT_CODE); | ||||
| 888 | } | ||||
| 889 | |||||
| 890 | ################################################## | ||||
| 891 | sub logexit { | ||||
| 892 | ################################################## | ||||
| 893 | my $self = shift; | ||||
| 894 | |||||
| 895 | local $Log::Log4perl::caller_depth = | ||||
| 896 | $Log::Log4perl::caller_depth + 1; | ||||
| 897 | |||||
| 898 | if ($self->is_fatal()) { | ||||
| 899 | # Since we're one caller level off now, compensate for that. | ||||
| 900 | my @chomped = @_; | ||||
| 901 | chomp($chomped[-1]); | ||||
| 902 | $self->fatal(@chomped); | ||||
| 903 | } | ||||
| 904 | |||||
| 905 | exit $Log::Log4perl::LOGEXIT_CODE; | ||||
| 906 | } | ||||
| 907 | |||||
| 908 | ################################################## | ||||
| 909 | # clucks and carps are WARN level | ||||
| 910 | sub logcluck { | ||||
| 911 | ################################################## | ||||
| 912 | my $self = shift; | ||||
| 913 | |||||
| 914 | local $Log::Log4perl::caller_depth = | ||||
| 915 | $Log::Log4perl::caller_depth + 1; | ||||
| 916 | |||||
| 917 | local $Carp::CarpLevel = | ||||
| 918 | $Carp::CarpLevel + 1; | ||||
| 919 | |||||
| 920 | my $msg = $self->warning_render(@_); | ||||
| 921 | |||||
| 922 | if ($self->is_warn()) { | ||||
| 923 | my $message = Carp::longmess($msg); | ||||
| 924 | foreach (split(/\n/, $message)) { | ||||
| 925 | $self->warn("$_\n"); | ||||
| 926 | } | ||||
| 927 | } | ||||
| 928 | |||||
| 929 | Carp::cluck($msg); | ||||
| 930 | } | ||||
| 931 | |||||
| 932 | ################################################## | ||||
| 933 | sub logcarp { | ||||
| 934 | ################################################## | ||||
| 935 | my $self = shift; | ||||
| 936 | |||||
| 937 | local $Carp::CarpLevel = $Carp::CarpLevel + 1; | ||||
| 938 | |||||
| 939 | local $Log::Log4perl::caller_depth = | ||||
| 940 | $Log::Log4perl::caller_depth + 1; | ||||
| 941 | |||||
| 942 | my $msg = $self->warning_render(@_); | ||||
| 943 | |||||
| 944 | if ($self->is_warn()) { | ||||
| 945 | my $message = Carp::shortmess($msg); | ||||
| 946 | foreach (split(/\n/, $message)) { | ||||
| 947 | $self->warn("$_\n"); | ||||
| 948 | } | ||||
| 949 | } | ||||
| 950 | |||||
| 951 | Carp::carp($msg); | ||||
| 952 | } | ||||
| 953 | |||||
| 954 | ################################################## | ||||
| 955 | # croaks and confess are FATAL level | ||||
| 956 | ################################################## | ||||
| 957 | sub logcroak { | ||||
| 958 | ################################################## | ||||
| 959 | my $self = shift; | ||||
| 960 | |||||
| 961 | my $msg = $self->warning_render(@_); | ||||
| 962 | |||||
| 963 | local $Carp::CarpLevel = | ||||
| 964 | $Carp::CarpLevel + 1; | ||||
| 965 | |||||
| 966 | local $Log::Log4perl::caller_depth = | ||||
| 967 | $Log::Log4perl::caller_depth + 1; | ||||
| 968 | |||||
| 969 | if ($self->is_fatal()) { | ||||
| 970 | my $message = Carp::shortmess($msg); | ||||
| 971 | foreach (split(/\n/, $message)) { | ||||
| 972 | $self->fatal("$_\n"); | ||||
| 973 | } | ||||
| 974 | } | ||||
| 975 | |||||
| 976 | $Log::Log4perl::LOGDIE_MESSAGE_ON_STDERR ? | ||||
| 977 | Carp::croak($msg) : | ||||
| 978 | exit($Log::Log4perl::LOGEXIT_CODE); | ||||
| 979 | } | ||||
| 980 | |||||
| 981 | ################################################## | ||||
| 982 | sub logconfess { | ||||
| 983 | ################################################## | ||||
| 984 | my $self = shift; | ||||
| 985 | |||||
| 986 | local $Carp::CarpLevel = | ||||
| 987 | $Carp::CarpLevel + 1; | ||||
| 988 | |||||
| 989 | local $Log::Log4perl::caller_depth = | ||||
| 990 | $Log::Log4perl::caller_depth + 1; | ||||
| 991 | |||||
| 992 | my $msg = $self->warning_render(@_); | ||||
| 993 | |||||
| 994 | if ($self->is_fatal()) { | ||||
| 995 | my $message = Carp::longmess($msg); | ||||
| 996 | foreach (split(/\n/, $message)) { | ||||
| 997 | $self->fatal("$_\n"); | ||||
| 998 | } | ||||
| 999 | } | ||||
| 1000 | |||||
| 1001 | $Log::Log4perl::LOGDIE_MESSAGE_ON_STDERR ? | ||||
| 1002 | confess($msg) : | ||||
| 1003 | exit($Log::Log4perl::LOGEXIT_CODE); | ||||
| 1004 | } | ||||
| 1005 | |||||
| 1006 | ################################################## | ||||
| 1007 | # in case people prefer to use error for warning | ||||
| 1008 | ################################################## | ||||
| 1009 | sub error_warn { | ||||
| 1010 | ################################################## | ||||
| 1011 | my $self = shift; | ||||
| 1012 | |||||
| 1013 | local $Log::Log4perl::caller_depth = | ||||
| 1014 | $Log::Log4perl::caller_depth + 1; | ||||
| 1015 | |||||
| 1016 | if ($self->is_error()) { | ||||
| 1017 | $self->error(@_); | ||||
| 1018 | } | ||||
| 1019 | |||||
| 1020 | $self->and_warn(@_); | ||||
| 1021 | } | ||||
| 1022 | |||||
| 1023 | ################################################## | ||||
| 1024 | sub error_die { | ||||
| 1025 | ################################################## | ||||
| 1026 | my $self = shift; | ||||
| 1027 | |||||
| 1028 | local $Log::Log4perl::caller_depth = | ||||
| 1029 | $Log::Log4perl::caller_depth + 1; | ||||
| 1030 | |||||
| 1031 | my $msg = $self->warning_render(@_); | ||||
| 1032 | |||||
| 1033 | if ($self->is_error()) { | ||||
| 1034 | $self->error($msg); | ||||
| 1035 | } | ||||
| 1036 | |||||
| 1037 | $Log::Log4perl::LOGDIE_MESSAGE_ON_STDERR ? | ||||
| 1038 | $self->and_die($msg) : | ||||
| 1039 | exit($Log::Log4perl::LOGEXIT_CODE); | ||||
| 1040 | } | ||||
| 1041 | |||||
| 1042 | ################################################## | ||||
| 1043 | sub more_logging { | ||||
| 1044 | ################################################## | ||||
| 1045 | my ($self) = shift; | ||||
| 1046 | return $self->dec_level(@_); | ||||
| 1047 | } | ||||
| 1048 | |||||
| 1049 | ################################################## | ||||
| 1050 | sub inc_level { | ||||
| 1051 | ################################################## | ||||
| 1052 | my ($self, $delta) = @_; | ||||
| 1053 | |||||
| 1054 | $delta ||= 1; | ||||
| 1055 | |||||
| 1056 | $self->level(Log::Log4perl::Level::get_higher_level($self->level(), | ||||
| 1057 | $delta)); | ||||
| 1058 | |||||
| 1059 | $self->set_output_methods; | ||||
| 1060 | } | ||||
| 1061 | |||||
| 1062 | ################################################## | ||||
| 1063 | sub less_logging { | ||||
| 1064 | ################################################## | ||||
| 1065 | my ($self) = shift; | ||||
| 1066 | return $self->inc_level(@_); | ||||
| 1067 | } | ||||
| 1068 | |||||
| 1069 | ################################################## | ||||
| 1070 | sub dec_level { | ||||
| 1071 | ################################################## | ||||
| 1072 | my ($self, $delta) = @_; | ||||
| 1073 | |||||
| 1074 | $delta ||= 1; | ||||
| 1075 | |||||
| 1076 | $self->level(Log::Log4perl::Level::get_lower_level($self->level(), $delta)); | ||||
| 1077 | |||||
| 1078 | $self->set_output_methods; | ||||
| 1079 | } | ||||
| 1080 | |||||
| 1081 | 1 | 21µs | 1; | ||
| 1082 | |||||
| 1083 | __END__ | ||||
# spent 500ns within Log::Log4perl::Logger::CORE:subst which was called:
# once (500ns+0s) by Log::Log4perl::Logger::_new at line 127 |