Profile of Log/Log4perl/Logger.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:39 2012

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

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 974µs | 8.74ms | Log::Log4perl::Logger::::BEGIN@12Log::Log4perl::Logger::BEGIN@12
1 | 1 | 1 | 953µs | 1.47ms | Log::Log4perl::Logger::::BEGIN@10Log::Log4perl::Logger::BEGIN@10
1 | 1 | 1 | 197µs | 197µs | Log::Log4perl::Logger::::BEGIN@13Log::Log4perl::Logger::BEGIN@13
1 | 1 | 1 | 184µs | 7.95ms | Log::Log4perl::Logger::::BEGIN@11Log::Log4perl::Logger::BEGIN@11
8 | 1 | 1 | 148µs | 148µs | Log::Log4perl::Logger::::create_log_level_methodsLog::Log4perl::Logger::create_log_level_methods
1 | 1 | 1 | 87µs | 99µs | Log::Log4perl::Logger::::cleanupLog::Log4perl::Logger::cleanup
1 | 1 | 1 | 80µs | 154µs | Log::Log4perl::Logger::::set_output_methodsLog::Log4perl::Logger::set_output_methods
10 | 3 | 1 | 30µs | 30µs | Log::Log4perl::Logger::::generate_watch_codeLog::Log4perl::Logger::generate_watch_code
1 | 1 | 1 | 27µs | 27µs | Log::Log4perl::Logger::::BEGIN@5Log::Log4perl::Logger::BEGIN@5
8 | 2 | 1 | 22µs | 45µs | Log::Log4perl::Logger::::generate_is_xxx_coderefLog::Log4perl::Logger::generate_is_xxx_coderef
1 | 1 | 1 | 19µs | 174µs | Log::Log4perl::Logger::::_newLog::Log4perl::Logger::_new
1 | 1 | 1 | 19µs | 198µs | Log::Log4perl::Logger::::resetLog::Log4perl::Logger::reset
1 | 1 | 1 | 15µs | 20µs | Log::Log4perl::Logger::::generate_coderefLog::Log4perl::Logger::generate_coderef
1 | 1 | 1 | 11µs | 31µs | Log::Log4perl::Logger::::BEGIN@731Log::Log4perl::Logger::BEGIN@731
1 | 1 | 1 | 10µs | 69µs | Log::Log4perl::Logger::::BEGIN@15Log::Log4perl::Logger::BEGIN@15
1 | 1 | 1 | 8µs | 11µs | Log::Log4perl::Logger::::BEGIN@6Log::Log4perl::Logger::BEGIN@6
1 | 1 | 1 | 8µs | 11µs | Log::Log4perl::Logger::::generate_noop_coderefLog::Log4perl::Logger::generate_noop_coderef
1 | 1 | 1 | 8µs | 22µs | Log::Log4perl::Logger::::BEGIN@7Log::Log4perl::Logger::BEGIN@7
1 | 1 | 1 | 7µs | 17µs | Log::Log4perl::Logger::::BEGIN@738Log::Log4perl::Logger::BEGIN@738
1 | 1 | 1 | 7µs | 40µs | Log::Log4perl::Logger::::BEGIN@20Log::Log4perl::Logger::BEGIN@20
1 | 1 | 1 | 7µs | 7µs | Log::Log4perl::Logger::::BEGIN@14Log::Log4perl::Logger::BEGIN@14
1 | 1 | 1 | 7µs | 7µs | Log::Log4perl::Logger::::BEGIN@9Log::Log4perl::Logger::BEGIN@9
1 | 1 | 1 | 6µs | 14µs | Log::Log4perl::Logger::::BEGIN@791Log::Log4perl::Logger::BEGIN@791
1 | 1 | 1 | 6µs | 14µs | Log::Log4perl::Logger::::BEGIN@760Log::Log4perl::Logger::BEGIN@760
1 | 1 | 1 | 3µs | 3µs | Log::Log4perl::Logger::::DESTROYLog::Log4perl::Logger::DESTROY
1 | 1 | 1 | 3µs | 3µs | Log::Log4perl::Logger::::levelLog::Log4perl::Logger::level
1 | 1 | 1 | 2µs | 2µs | Log::Log4perl::Logger::::parent_loggerLog::Log4perl::Logger::parent_logger
1 | 1 | 1 | 500ns | 500ns | Log::Log4perl::Logger::::CORE:substLog::Log4perl::Logger::CORE:subst (opcode)
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::__ANON__[:300]Log::Log4perl::Logger::__ANON__[:300]
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::__ANON__[:324]Log::Log4perl::Logger::__ANON__[:324]
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::__ANON__[:347]Log::Log4perl::Logger::__ANON__[:347]
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::__ANON__[:416]Log::Log4perl::Logger::__ANON__[:416]
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::__ANON__[:428]Log::Log4perl::Logger::__ANON__[:428]
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::__ANON__[:435]Log::Log4perl::Logger::__ANON__[:435]
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::__ANON__[:773]Log::Log4perl::Logger::__ANON__[:773]
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::__ANON__[:783]Log::Log4perl::Logger::__ANON__[:783]
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::add_appenderLog::Log4perl::Logger::add_appender
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::additivityLog::Log4perl::Logger::additivity
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::and_dieLog::Log4perl::Logger::and_die
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::and_warnLog::Log4perl::Logger::and_warn
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::callerlineLog::Log4perl::Logger::callerline
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::create_custom_levelLog::Log4perl::Logger::create_custom_level
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::dec_levelLog::Log4perl::Logger::dec_level
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::eradicate_appenderLog::Log4perl::Logger::eradicate_appender
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::error_dieLog::Log4perl::Logger::error_die
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::error_warnLog::Log4perl::Logger::error_warn
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::generate_watch_conditionalLog::Log4perl::Logger::generate_watch_conditional
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::get_loggerLog::Log4perl::Logger::get_logger
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::get_root_loggerLog::Log4perl::Logger::get_root_logger
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::has_appendersLog::Log4perl::Logger::has_appenders
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::inc_levelLog::Log4perl::Logger::inc_level
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::init_warnLog::Log4perl::Logger::init_warn
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::less_loggingLog::Log4perl::Logger::less_logging
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::logLog::Log4perl::Logger::log
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::logcarpLog::Log4perl::Logger::logcarp
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::logcluckLog::Log4perl::Logger::logcluck
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::logconfessLog::Log4perl::Logger::logconfess
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::logcroakLog::Log4perl::Logger::logcroak
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::logdieLog::Log4perl::Logger::logdie
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::logexitLog::Log4perl::Logger::logexit
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::logwarnLog::Log4perl::Logger::logwarn
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::more_loggingLog::Log4perl::Logger::more_logging
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::parent_stringLog::Log4perl::Logger::parent_string
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::remove_appenderLog::Log4perl::Logger::remove_appender
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::reset_all_output_methodsLog::Log4perl::Logger::reset_all_output_methods
0 | 0 | 0 | 0s | 0s | Log::Log4perl::Logger::::warning_renderLog::Log4perl::Logger::warning_render

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::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 use 5.006; # 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 use strict; # 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 use warnings; # 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 use Log::Log4perl; # 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 use Log::Log4perl::Level; # 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 use Log::Log4perl::Layout; # 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 use Log::Log4perl::Appender; # 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 use Log::Log4perl::Appender::String; # 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 use Log::Log4perl::Filter; # 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 use Carp; # 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 use constant _INTERNAL_DEBUG => 0; # 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 sub cleanup {
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 | 1 | 12µ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 | 1 | 5µs |  |  | $LOGGERS_BY_NAME = {};
69 |  |  |  |  |
70 |  |  |  |  | # Delete the root logger
71 | 1 | 16µs |  |  | undef $ROOT_LOGGER;
72 |  |  |  |  |
73 |  |  |  |  | # Delete all appenders
74 | 1 | 35µs | 1 | 3µs | %APPENDER_BY_NAME = (); # spent 3µs making 1 call to Log::Log4perl::Logger::DESTROY
75 |  |  |  |  |
76 | 1 | 10µs |  |  | 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 sub DESTROY {
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 sub reset {
88 |  |  |  |  | ##################################################
89 | 1 | 2µ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 | 1 | 700ns |  |  | %APPENDER_BY_NAME = ();
95 | 1 | 500ns |  |  | undef $INITIALIZED;
96 | 1 | 200ns |  |  | undef $NON_INIT_WARNED;
97 | 1 | 2µs | 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 | 1 | 2µs |  |  | foreach my $logger (values %$LOGGERS_BY_NAME){
101 | 1 | 900ns |  |  | $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 | 1 | 3µs |  |  | 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 | 5µs | 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 sub _new {
118 |  |  |  |  | ##################################################
119 | 1 | 1µs |  |  | my($class, $category, $level) = @_;
120 |  |  |  |  |
121 | 1 | 300ns |  |  | print("_new: $class/$category/", defined $level ? $level : "undef",
122 |  |  |  |  | "\n") if _INTERNAL_DEBUG;
123 |  |  |  |  |
124 | 1 | 300ns |  |  | die "usage: __PACKAGE__->_new(category)" unless
125 |  |  |  |  | defined $category;
126 |  |  |  |  |
127 | 1 | 5µs | 1 | 500ns | $category =~ s/::/./g; # spent 500ns making 1 call to Log::Log4perl::Logger::CORE:subst
128 |  |  |  |  |
129 |  |  |  |  | # Have we created it previously?
130 | 1 | 1µs |  |  | if(exists $LOGGERS_BY_NAME->{$category}) {
131 |  |  |  |  | print "_new: exists already\n" if _INTERNAL_DEBUG;
132 |  |  |  |  | return $LOGGERS_BY_NAME->{$category};
133 |  |  |  |  | }
134 |  |  |  |  |
135 | 1 | 2µs |  |  | my $self = {
136 |  |  |  |  | category => $category,
137 |  |  |  |  | num_appenders => 0,
138 |  |  |  |  | additivity => 1,
139 |  |  |  |  | level => $level,
140 |  |  |  |  | layout => undef,
141 |  |  |  |  | };
142 |  |  |  |  |
143 | 1 | 2µs |  |  | bless $self, $class;
144 |  |  |  |  |
145 | 1 | 300ns |  |  | $level ||= $self->level();
146 |  |  |  |  |
147 |  |  |  |  | # Save it in global structure
148 | 1 | 1µs |  |  | $LOGGERS_BY_NAME->{$category} = $self;
149 |  |  |  |  |
150 | 1 | 2µs | 1 | 154µs | $self->set_output_methods; # spent 154µs making 1 call to Log::Log4perl::Logger::set_output_methods
151 |  |  |  |  |
152 | 1 | 100ns |  |  | print("Created logger $self ($category)\n") if _INTERNAL_DEBUG;
153 |  |  |  |  |
154 | 1 | 3µs |  |  | 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 sub set_output_methods {
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 | 1 | 500ns |  |  | my ($self) = @_;
177 |  |  |  |  |
178 | 1 | 400ns |  |  | my (@appenders, %seen);
179 |  |  |  |  |
180 | 1 | 2µs | 1 | 3µs | my ($level) = $self->level(); # spent 3µs making 1 call to Log::Log4perl::Logger::level
181 |  |  |  |  |
182 | 1 | 200ns |  |  | print "set_output_methods: $self->{category}/$level\n" if _INTERNAL_DEBUG;
183 |  |  |  |  |
184 |  |  |  |  | #collect the appenders in effect for this category
185 |  |  |  |  |
186 | 1 | 3µs | 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 | 1 | 2µs |  |  | 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 | 1 | 400ns |  |  | last unless $logger->{additivity};
201 | 1 | 500ns |  |  | }
202 |  |  |  |  |
203 |  |  |  |  | #make a no-op coderef for inactive levels
204 | 1 | 2µs | 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 | 1 | 1µs |  |  | my $coderef = (! @appenders ? $noop : &generate_coderef(\@appenders));
208 |  |  |  |  |
209 | 1 | 7µs |  |  | my %priority = %Log::Log4perl::Level::PRIORITY; #convenience and cvs
210 |  |  |  |  |
211 |  |  |  |  | # changed to >= from <= as level ints were reversed
212 | 1 | 6µs |  |  | foreach my $levelname (keys %priority){
213 | 8 | 11µs | 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 | 1 | 100ns |  |  | print " ($priority{$levelname} <= $level)\n"
217 |  |  |  |  | if _INTERNAL_DEBUG;
218 | 1 | 500ns |  |  | $self->{$levelname} = $coderef;
219 | 1 | 2µs | 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 | 1 | 400ns |  |  | print "Setting is_$levelname to 1\n" if _INTERNAL_DEBUG;
221 |  |  |  |  | }else{
222 | 7 | 700ns |  |  | print " ($priority{$levelname} > $level)\n" if _INTERNAL_DEBUG;
223 | 7 | 4µs |  |  | $self->{$levelname} = $noop;
224 | 7 | 13µs | 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 | 7 | 2µs |  |  | print "Setting is_$levelname to 0\n" if _INTERNAL_DEBUG;
226 |  |  |  |  | }
227 |  |  |  |  |
228 | 8 | 3µs |  |  | 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 sub generate_coderef {
237 |  |  |  |  | ##################################################
238 | 1 | 300ns |  |  | my $appenders = shift;
239 |  |  |  |  |
240 | 1 | 100ns |  |  | print "generate_coderef: ", scalar @$appenders,
241 |  |  |  |  | " appenders\n" if _INTERNAL_DEBUG;
242 |  |  |  |  |
243 | 1 | 2µs | 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 | 1 | 10µs |  |  | }; #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 sub generate_noop_coderef {
305 |  |  |  |  | ##################################################
306 | 1 | 200ns |  |  | 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 | 1µs | 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 | 1 | 300ns |  |  | my $coderef;
320 |  |  |  |  |
321 | 1 | 700ns |  |  | if(defined $Log::Log4perl::Config::WATCHER) {
322 |  |  |  |  | $coderef = $watch_check_code;
323 |  |  |  |  | } else {
324 | 1 | 2µs |  |  | $coderef = sub { undef };
325 |  |  |  |  | }
326 |  |  |  |  |
327 | 1 | 4µs |  |  | return $coderef;
328 |  |  |  |  | }
329 |  |  |  |  |
330 |  |  |  |  | ##################################################
331 |  |  |  |  | # spent 45µs (22+22) within Log::Log4perl::Logger::generate_is_xxx_coderef which was called 8 times, avg 6µs/call: # 7 times (20µs+20µs) by Log::Log4perl::Logger::set_output_methods at line 224, avg 6µs/call # once (2µs+2µs) by Log::Log4perl::Logger::set_output_methods at line 219 sub generate_is_xxx_coderef {
332 |  |  |  |  | ##################################################
333 | 8 | 3µs |  |  | my($return_token) = @_;
334 |  |  |  |  |
335 | 8 | 19µs | 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 sub generate_watch_code {
340 |  |  |  |  | ##################################################
341 | 10 | 5µs |  |  | my($type, $return_token) = @_;
342 |  |  |  |  |
343 | 10 | 1µs |  |  | print "generate_watch_code:\n" if _INTERNAL_DEBUG;
344 |  |  |  |  |
345 |  |  |  |  | # No watcher configured, return a no-op as watch code.
346 | 10 | 39µs |  |  | 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 sub level {
460 |  |  |  |  | ##################################################
461 | 1 | 700ns |  |  | my($self, $level, $dont_reset_all) = @_;
462 |  |  |  |  |
463 |  |  |  |  | # 'Set' function
464 | 1 | 200ns |  |  | 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 | 1 | 4µs |  |  | 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 sub parent_logger {
505 |  |  |  |  | # Get the parent of the current logger or undef
506 |  |  |  |  | ##################################################
507 | 1 | 500ns |  |  | my($logger) = @_;
508 |  |  |  |  |
509 |  |  |  |  | # Is it the root logger?
510 | 1 | 3µs |  |  | 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 no strict qw(refs); # 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 use strict qw(refs); # 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 sub create_log_level_methods {
753 |  |  |  |  | ########################################
754 | 8 | 4µs |  |  | my $level = shift || die("create_log_level_methods: " .
755 |  |  |  |  | "forgot to pass in a level string!");
756 | 8 | 4µs |  |  | my $lclevel = lc($level);
757 | 8 | 5µs |  |  | my $levelint = uc($level) . "_INT";
758 | 8 | 4µs |  |  | 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 no strict qw(refs); # 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 | 8 | 38µs |  |  | };
774 |  |  |  |  |
775 |  |  |  |  | # Added these to have is_xxx functions as fast as xxx functions
776 |  |  |  |  | # -ms
777 |  |  |  |  |
778 | 8 | 4µs |  |  | my $islevel = "is_" . $level;
779 | 8 | 3µs |  |  | my $islclevel = "is_" . $lclevel;
780 |  |  |  |  |
781 |  |  |  |  | *{__PACKAGE__ . "::is_$lclevel"} = sub {
782 |  |  |  |  | $_[0]->{$islevel}->($_[0], $islclevel);
783 | 8 | 42µs |  |  | };
784 |  |  |  |  |
785 |  |  |  |  | # Add the isXxxEnabled() methods as identical to the is_xxx
786 |  |  |  |  | # functions. - dviner
787 |  |  |  |  |
788 |  |  |  |  | *{__PACKAGE__ . "::is".$initial_cap."Enabled"} =
789 | 8 | 32µs |  |  | \&{__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 use strict qw(refs); # spent 14µs making 1 call to Log::Log4perl::Logger::BEGIN@791 # spent 8µs making 1 call to strict::import
792 |  |  |  |  |
793 | 8 | 23µs |  |  | 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 sub Log::Log4perl::Logger::CORE:subst; # opcode