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 | BEGIN@12 | Log::Log4perl::Logger::
1 | 1 | 1 | 953µs | 1.47ms | BEGIN@10 | Log::Log4perl::Logger::
1 | 1 | 1 | 197µs | 197µs | BEGIN@13 | Log::Log4perl::Logger::
1 | 1 | 1 | 184µs | 7.95ms | BEGIN@11 | Log::Log4perl::Logger::
8 | 1 | 1 | 148µs | 148µs | create_log_level_methods | Log::Log4perl::Logger::
1 | 1 | 1 | 87µs | 99µs | cleanup | Log::Log4perl::Logger::
1 | 1 | 1 | 80µs | 154µs | set_output_methods | Log::Log4perl::Logger::
10 | 3 | 1 | 30µs | 30µs | generate_watch_code | Log::Log4perl::Logger::
1 | 1 | 1 | 27µs | 27µs | BEGIN@5 | Log::Log4perl::Logger::
8 | 2 | 1 | 22µs | 45µs | generate_is_xxx_coderef | Log::Log4perl::Logger::
1 | 1 | 1 | 19µs | 174µs | _new | Log::Log4perl::Logger::
1 | 1 | 1 | 19µs | 198µs | reset | Log::Log4perl::Logger::
1 | 1 | 1 | 15µs | 20µs | generate_coderef | Log::Log4perl::Logger::
1 | 1 | 1 | 11µs | 31µs | BEGIN@731 | Log::Log4perl::Logger::
1 | 1 | 1 | 10µs | 69µs | BEGIN@15 | Log::Log4perl::Logger::
1 | 1 | 1 | 8µs | 11µs | BEGIN@6 | Log::Log4perl::Logger::
1 | 1 | 1 | 8µs | 11µs | generate_noop_coderef | Log::Log4perl::Logger::
1 | 1 | 1 | 8µs | 22µs | BEGIN@7 | Log::Log4perl::Logger::
1 | 1 | 1 | 7µs | 17µs | BEGIN@738 | Log::Log4perl::Logger::
1 | 1 | 1 | 7µs | 40µs | BEGIN@20 | Log::Log4perl::Logger::
1 | 1 | 1 | 7µs | 7µs | BEGIN@14 | Log::Log4perl::Logger::
1 | 1 | 1 | 7µs | 7µs | BEGIN@9 | Log::Log4perl::Logger::
1 | 1 | 1 | 6µs | 14µs | BEGIN@791 | Log::Log4perl::Logger::
1 | 1 | 1 | 6µs | 14µs | BEGIN@760 | Log::Log4perl::Logger::
1 | 1 | 1 | 3µs | 3µs | DESTROY | Log::Log4perl::Logger::
1 | 1 | 1 | 3µs | 3µs | level | Log::Log4perl::Logger::
1 | 1 | 1 | 2µs | 2µs | parent_logger | Log::Log4perl::Logger::
1 | 1 | 1 | 500ns | 500ns | CORE:subst (opcode) | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | __ANON__[:300] | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | __ANON__[:324] | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | __ANON__[:347] | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | __ANON__[:416] | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | __ANON__[:428] | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | __ANON__[:435] | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | __ANON__[:773] | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | __ANON__[:783] | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | add_appender | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | additivity | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | and_die | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | and_warn | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | callerline | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | create_custom_level | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | dec_level | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | eradicate_appender | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | error_die | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | error_warn | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | generate_watch_conditional | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | get_logger | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | get_root_logger | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | has_appenders | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | inc_level | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | init_warn | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | less_logging | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | log | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | logcarp | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | logcluck | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | logconfess | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | logcroak | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | logdie | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | logexit | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | logwarn | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | more_logging | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | parent_string | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | remove_appender | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | reset_all_output_methods | Log::Log4perl::Logger::
0 | 0 | 0 | 0s | 0s | warning_render | Log::Log4perl::Logger::
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 | 7 | 12µ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 | 2 | 4µs | $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 | 10 | 23µ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 | 2 | 2µ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 | 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 | 48 | 37µ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 | 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 | 5 | 7µ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 | 1 | 2µs | 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 |