… | |
… | |
10 | AE::log debug => "hit my knee"; |
10 | AE::log debug => "hit my knee"; |
11 | AE::log warn => "it's a bit too hot"; |
11 | AE::log warn => "it's a bit too hot"; |
12 | AE::log error => "the flag was false!"; |
12 | AE::log error => "the flag was false!"; |
13 | AE::log fatal => "the bit toggled! run!"; |
13 | AE::log fatal => "the bit toggled! run!"; |
14 | |
14 | |
15 | # complex use |
15 | # "complex" use |
16 | use AnyEvent::Log; |
16 | use AnyEvent::Log; |
17 | |
17 | |
18 | my $tracer = AnyEvent::Log::logger trace => \$my $trace; |
18 | my $tracer = AnyEvent::Log::logger trace => \$my $trace; |
19 | |
19 | |
20 | $tracer->("i am here") if $trace; |
20 | $tracer->("i am here") if $trace; |
21 | $tracer->(sub { "lots of data: " . Dumper $self }) if $trace; |
21 | $tracer->(sub { "lots of data: " . Dumper $self }) if $trace; |
22 | |
22 | |
23 | #TODO: config |
23 | # configuration |
24 | #TODO: ctx () becomes caller[0]... |
24 | |
|
|
25 | # set logging for this package to maximum |
|
|
26 | AnyEvent::Log::ctx->level ("all"); |
|
|
27 | |
|
|
28 | # set logging globally to anything below debug |
|
|
29 | (AnyEvent::Log::ctx "")->level ("notice"); |
|
|
30 | |
|
|
31 | # see also EXAMPLES, below |
|
|
32 | |
|
|
33 | # disable logging for package "AnyEvent" and all packages below it |
|
|
34 | AnyEvent->AnyEvent::Log::ctx->level (0); |
|
|
35 | |
|
|
36 | # log everything below debug to a file, for the whole program |
|
|
37 | my $ctx = AnyEvent::Log::ctx; |
|
|
38 | $ctx->log_cb (sub { print FILE shift; 0 }); |
|
|
39 | (AnyEvent::Log::ctx "")->add ($ctx); |
25 | |
40 | |
26 | =head1 DESCRIPTION |
41 | =head1 DESCRIPTION |
27 | |
42 | |
28 | This module implements a relatively simple "logging framework". It doesn't |
43 | This module implements a relatively simple "logging framework". It doesn't |
29 | attempt to be "the" logging solution or even "a" logging solution for |
44 | attempt to be "the" logging solution or even "a" logging solution for |
… | |
… | |
37 | something like: |
52 | something like: |
38 | |
53 | |
39 | use AnyEvent; |
54 | use AnyEvent; |
40 | (AnyEvent::Log::ctx "")->level ("info"); |
55 | (AnyEvent::Log::ctx "")->level ("info"); |
41 | |
56 | |
|
|
57 | The design goal behind this module was to keep it simple (and small), |
|
|
58 | but make it powerful enough to be potentially useful for any module, and |
|
|
59 | extensive enough for the most common tasks, such as logging to multiple |
|
|
60 | targets, or being able to log into a database. |
|
|
61 | |
42 | =head1 LOGGING FUNCTIONS |
62 | =head1 LOGGING FUNCTIONS |
43 | |
63 | |
44 | These functions allow you to log messages. They always use the caller's |
64 | These functions allow you to log messages. They always use the caller's |
45 | package as a "logging module/source". Also, the main logging function is |
65 | package as a "logging module/source". Also, the main logging function is |
46 | callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is |
66 | callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is |
… | |
… | |
71 | "$now_str1$f$now_str2" |
91 | "$now_str1$f$now_str2" |
72 | } |
92 | } |
73 | |
93 | |
74 | our %CTX; # all logging contexts |
94 | our %CTX; # all logging contexts |
75 | |
95 | |
76 | my $default_log_cb = sub { 0 }; |
|
|
77 | |
|
|
78 | # creates a default package context object for the given package |
96 | # creates a default package context object for the given package |
79 | sub _pkg_ctx($) { |
97 | sub _pkg_ctx($) { |
80 | my $ctx = bless [$_[0], 0, {}, $default_log_cb], "AnyEvent::Log::Ctx"; |
98 | my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx"; |
81 | |
99 | |
82 | # link "parent" package |
100 | # link "parent" package |
83 | my $pkg = $_[0] =~ /^(.+)::/ ? $1 : ""; |
101 | my $pkg = $_[0] =~ /^(.+)::/ ? $1 : ""; |
84 | |
102 | |
85 | $pkg = $CTX{$pkg} ||= &_pkg_ctx ($pkg); |
103 | $pkg = $CTX{$pkg} ||= &_pkg_ctx ($pkg); |
… | |
… | |
146 | debug => 8, |
164 | debug => 8, |
147 | trace => 9, |
165 | trace => 9, |
148 | ); |
166 | ); |
149 | |
167 | |
150 | sub now () { time } |
168 | sub now () { time } |
|
|
169 | |
151 | AnyEvent::post_detect { |
170 | AnyEvent::post_detect { |
152 | *now = \&AE::now; |
171 | *now = \&AE::now; |
153 | }; |
172 | }; |
154 | |
173 | |
155 | our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace); |
174 | our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace); |
156 | |
175 | |
157 | # time, ctx, level, msg |
176 | # time, ctx, level, msg |
158 | sub _format($$$$) { |
177 | sub _format($$$$) { |
159 | my $pfx = ft $_[0]; |
178 | my $pfx = ft $_[0]; |
|
|
179 | my @res; |
160 | |
180 | |
161 | join "", |
|
|
162 | map "$pfx $_\n", |
|
|
163 | split /\n/, |
|
|
164 | sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3] |
181 | for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) { |
|
|
182 | push @res, "$pfx $_\n"; |
|
|
183 | $pfx = "\t"; |
|
|
184 | } |
|
|
185 | |
|
|
186 | join "", @res |
165 | } |
187 | } |
166 | |
188 | |
167 | sub _log { |
189 | sub _log { |
168 | my ($ctx, $level, $format, @args) = @_; |
190 | my ($ctx, $level, $format, @args) = @_; |
169 | |
191 | |
170 | $level = $level > 0 && $level <= 9 ? $level+0 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; |
192 | $level = $level > 0 && $level <= 9 ? $level+0 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; |
171 | |
193 | |
172 | my $mask = 1 << $level; |
194 | my $mask = 1 << $level; |
173 | my $now = AE::now; |
|
|
174 | |
195 | |
175 | my (@ctx, $did_format, $fmt); |
196 | my (@ctx, $now, $fmt); |
176 | |
197 | |
177 | do { |
198 | do { |
|
|
199 | # skip if masked |
|
|
200 | next unless $ctx->[1] & $mask; |
|
|
201 | |
178 | if ($ctx->[1] & $mask) { |
202 | if ($ctx->[3]) { |
179 | # logging target found |
203 | # logging target found |
180 | |
204 | |
181 | # get raw message |
205 | # now get raw message, unless we have it already |
182 | unless ($did_format) { |
206 | unless ($now) { |
183 | $format = $format->() if ref $format; |
207 | $format = $format->() if ref $format; |
184 | $format = sprintf $format, @args if @args; |
208 | $format = sprintf $format, @args if @args; |
185 | $format =~ s/\n$//; |
209 | $format =~ s/\n$//; |
186 | $did_format = 1; |
210 | $now = AE::now; |
187 | }; |
211 | }; |
188 | |
212 | |
189 | # format msg |
213 | # format msg |
190 | my $str = $ctx->[4] |
214 | my $str = $ctx->[4] |
191 | ? $ctx->[4]($now, $_[0], $level, $format) |
215 | ? $ctx->[4]($now, $_[0], $level, $format) |
… | |
… | |
193 | |
217 | |
194 | $ctx->[3]($str) |
218 | $ctx->[3]($str) |
195 | and next; |
219 | and next; |
196 | } |
220 | } |
197 | |
221 | |
198 | # not consume - push parent contexts |
222 | # not masked, not consume - propagate to parent contexts |
199 | push @ctx, values %{ $ctx->[2] }; |
223 | push @ctx, values %{ $ctx->[2] }; |
200 | } while $ctx = pop @ctx; |
224 | } while $ctx = pop @ctx; |
201 | |
225 | |
202 | exit 1 if $level <= 1; |
226 | exit 1 if $level <= 1; |
203 | } |
227 | } |
… | |
… | |
306 | _logger |
330 | _logger |
307 | $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], |
331 | $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], |
308 | @_ |
332 | @_ |
309 | } |
333 | } |
310 | |
334 | |
311 | #TODO |
|
|
312 | |
|
|
313 | =back |
335 | =back |
314 | |
336 | |
315 | =head1 LOGGING CONTEXTS |
337 | =head1 LOGGING CONTEXTS |
316 | |
338 | |
317 | This module associates every log message with a so-called I<logging |
339 | This module associates every log message with a so-called I<logging |
318 | context>, based on the package of the caller. Every perl package has its |
340 | context>, based on the package of the caller. Every perl package has its |
319 | own logging context. |
341 | own logging context. |
320 | |
342 | |
321 | A logging context has two major responsibilities: logging the message and |
343 | A logging context has three major responsibilities: filtering, logging and |
322 | propagating the message to other contexts. |
344 | propagating the message. |
323 | |
345 | |
324 | For logging, the context stores a set of logging levels that it |
346 | For the first purpose, filtering, each context has a set of logging |
325 | potentially wishes to log, a formatting callback that takes the timestamp, |
347 | levels, called the log level mask. Messages not in the set will be ignored |
|
|
348 | by this context (masked). |
|
|
349 | |
|
|
350 | For logging, the context stores a formatting callback (which takes the |
326 | context, level and string emssage and formats it in the way it should be |
351 | timestamp, context, level and string message and formats it in the way |
327 | logged, and a logging callback, which is responsible for actually logging |
352 | it should be logged) and a logging callback (which is responsible for |
328 | the formatted message and telling C<AnyEvent::Log> whether it has consumed |
353 | actually logging the formatted message and telling C<AnyEvent::Log> |
329 | the message, or whether it should be propagated. |
354 | whether it has consumed the message, or whether it should be propagated). |
330 | |
355 | |
331 | For propagation, a context can have any number of attached I<parent |
356 | For propagation, a context can have any number of attached I<parent |
332 | contexts>. They will be ignored if the logging callback consumes the |
357 | contexts>. Any message that is neither masked by the logging mask nor |
333 | message, but in all other cases, the log message will be passed to all |
358 | masked by the logging callback returning true will be passed to all parent |
334 | parent contexts attached to a context. |
359 | contexts. |
335 | |
360 | |
336 | =head2 DEFAULTS |
361 | =head2 DEFAULTS |
337 | |
362 | |
338 | By default, all logging contexts have an empty set of log levels, a |
363 | By default, all logging contexts have an full set of log levels ("all"), a |
339 | disabled logging callback and the default formatting callback. |
364 | disabled logging callback and the default formatting callback. |
340 | |
365 | |
341 | Package contexts have the package name as logging title by default. |
366 | Package contexts have the package name as logging title by default. |
342 | |
367 | |
343 | They have exactly one parent - the context of the "parent" package. The |
368 | They have exactly one parent - the context of the "parent" package. The |
… | |
… | |
354 | When the module is first loaded, it configures the root context (the one |
379 | When the module is first loaded, it configures the root context (the one |
355 | with the empty string) to simply dump all log messages to C<STDERR>, |
380 | with the empty string) to simply dump all log messages to C<STDERR>, |
356 | and sets it's log level set to all levels up to the one specified by |
381 | and sets it's log level set to all levels up to the one specified by |
357 | C<$ENV{PERL_ANYEVENT_VERBOSE}>. |
382 | C<$ENV{PERL_ANYEVENT_VERBOSE}>. |
358 | |
383 | |
359 | The effetc of all this is that log messages, by default, wander up to the |
384 | The effect of all this is that log messages, by default, wander up to the |
360 | root context and will be logged to STDERR if their log level is less than |
385 | root context and will be logged to STDERR if their log level is less than |
361 | or equal to C<$ENV{PERL_ANYEVENT_VERBOSE}>. |
386 | or equal to C<$ENV{PERL_ANYEVENT_VERBOSE}>. |
362 | |
387 | |
363 | =head2 CREATING/FINDING A CONTEXT |
388 | =head2 CREATING/FINDING A CONTEXT |
364 | |
389 | |
… | |
… | |
383 | |
408 | |
384 | ref $pkg |
409 | ref $pkg |
385 | ? $pkg |
410 | ? $pkg |
386 | : defined $pkg |
411 | : defined $pkg |
387 | ? $CTX{$pkg} ||= AnyEvent::Log::_pkg_ctx $pkg |
412 | ? $CTX{$pkg} ||= AnyEvent::Log::_pkg_ctx $pkg |
388 | : bless [undef, 0, undef, $default_log_cb], "AnyEvent::Log::Ctx" |
413 | : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx" |
389 | } |
414 | } |
390 | |
415 | |
391 | # create default root context |
416 | # create default root context |
392 | { |
417 | { |
393 | my $root = ctx undef; |
418 | my $root = ctx undef; |
… | |
… | |
432 | |
457 | |
433 | =back |
458 | =back |
434 | |
459 | |
435 | =head3 LOGGING LEVELS |
460 | =head3 LOGGING LEVELS |
436 | |
461 | |
437 | The following methods deal with the logging level set associated wiht the log context. |
462 | The following methods deal with the logging level set associated with the |
|
|
463 | log context. |
438 | |
464 | |
439 | The most common method to use is probably C<< $ctx->level ($level) >>, |
465 | The most common method to use is probably C<< $ctx->level ($level) >>, |
440 | which configures the specified and any higher priority levels. |
466 | which configures the specified and any higher priority levels. |
441 | |
467 | |
|
|
468 | All functions which accept a list of levels also accept the special string |
|
|
469 | C<all> which expands to all logging levels. |
|
|
470 | |
442 | =over 4 |
471 | =over 4 |
443 | |
472 | |
444 | =item $ctx->levels ($level[, $level...) |
473 | =item $ctx->levels ($level[, $level...) |
445 | |
474 | |
446 | Enables logging fot the given levels and disables it for all others. |
475 | Enables logging for the given levels and disables it for all others. |
447 | |
476 | |
448 | =item $ctx->level ($level) |
477 | =item $ctx->level ($level) |
449 | |
478 | |
450 | Enables logging for the given level and all lower level (higher priority) |
479 | Enables logging for the given level and all lower level (higher priority) |
451 | ones. Specifying a level of C<0> or C<off> disables all logging for this |
480 | ones. In addition to normal logging levels, specifying a level of C<0> or |
452 | level. |
481 | C<off> disables all logging for this level. |
453 | |
482 | |
454 | Example: log warnings, errors and higher priority messages. |
483 | Example: log warnings, errors and higher priority messages. |
455 | |
484 | |
456 | $ctx->level ("warn"); |
485 | $ctx->level ("warn"); |
457 | $ctx->level (5); # same thing, just numeric |
486 | $ctx->level (5); # same thing, just numeric |
… | |
… | |
465 | Disables logging for the given levels, leaving all others unchanged. |
494 | Disables logging for the given levels, leaving all others unchanged. |
466 | |
495 | |
467 | =cut |
496 | =cut |
468 | |
497 | |
469 | sub _lvl_lst { |
498 | sub _lvl_lst { |
|
|
499 | map { |
|
|
500 | $_ > 0 && $_ <= 9 ? $_+0 |
|
|
501 | : $_ eq "all" ? (1 .. 9) |
470 | map { $_ > 0 && $_ <= 9 ? $_+0 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" } |
502 | : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" |
471 | @_ |
503 | } @_ |
472 | } |
504 | } |
473 | |
505 | |
474 | our $NOP_CB = sub { 0 }; |
506 | our $NOP_CB = sub { 0 }; |
475 | |
507 | |
476 | sub levels { |
508 | sub levels { |
… | |
… | |
481 | AnyEvent::Log::_reassess; |
513 | AnyEvent::Log::_reassess; |
482 | } |
514 | } |
483 | |
515 | |
484 | sub level { |
516 | sub level { |
485 | my $ctx = shift; |
517 | my $ctx = shift; |
486 | my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[0]; |
518 | my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]; |
|
|
519 | |
487 | $ctx->[1] = ((1 << $lvl) - 1) << 1; |
520 | $ctx->[1] = ((1 << $lvl) - 1) << 1; |
488 | AnyEvent::Log::_reassess; |
521 | AnyEvent::Log::_reassess; |
489 | } |
522 | } |
490 | |
523 | |
491 | sub enable { |
524 | sub enable { |
… | |
… | |
547 | =back |
580 | =back |
548 | |
581 | |
549 | =head3 MESSAGE LOGGING |
582 | =head3 MESSAGE LOGGING |
550 | |
583 | |
551 | The following methods configure how the logging context actually does |
584 | The following methods configure how the logging context actually does |
552 | the logging (which consists of foratting the message and printing it or |
585 | the logging (which consists of formatting the message and printing it or |
553 | whatever it wants to do with it) and also allows you to log messages |
586 | whatever it wants to do with it) and also allows you to log messages |
554 | directly to a context, without going via your package context. |
587 | directly to a context, without going via your package context. |
555 | |
588 | |
556 | =over 4 |
589 | =over 4 |
557 | |
590 | |
… | |
… | |
571 | Example: a very simple logging callback, simply dump the message to STDOUT |
604 | Example: a very simple logging callback, simply dump the message to STDOUT |
572 | and do not consume it. |
605 | and do not consume it. |
573 | |
606 | |
574 | $ctx->log_cb (sub { print STDERR shift; 0 }); |
607 | $ctx->log_cb (sub { print STDERR shift; 0 }); |
575 | |
608 | |
|
|
609 | You can filter messages by having a log callback that simply returns C<1> |
|
|
610 | and does not do anything with the message, but this counts as "message |
|
|
611 | being logged" and might not be very efficient. |
|
|
612 | |
|
|
613 | Example: propagate all messages except for log levels "debug" and |
|
|
614 | "trace". The messages will still be generated, though, which can slow down |
|
|
615 | your program. |
|
|
616 | |
|
|
617 | $ctx->levels ("debug", "trace"); |
|
|
618 | $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages |
|
|
619 | |
576 | =item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message)) |
620 | =item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message)) |
577 | |
621 | |
578 | Replaces the fornatting callback on the cobntext (C<undef> restores the |
622 | Replaces the formatting callback on the context (C<undef> restores the |
579 | default formatter). |
623 | default formatter). |
580 | |
624 | |
581 | The callback is passed the (possibly fractional) timestamp, the original |
625 | The callback is passed the (possibly fractional) timestamp, the original |
582 | logging context, the (numeric) logging level and the raw message string and needs to |
626 | logging context, the (numeric) logging level and the raw message string and needs to |
583 | return a formatted log message. In most cases this will be a string, but |
627 | return a formatted log message. In most cases this will be a string, but |
… | |
… | |
611 | =cut |
655 | =cut |
612 | |
656 | |
613 | sub log_cb { |
657 | sub log_cb { |
614 | my ($ctx, $cb) = @_; |
658 | my ($ctx, $cb) = @_; |
615 | |
659 | |
616 | $ctx->[3] = $cb || $default_log_cb; |
660 | $ctx->[3] = $cb; |
617 | } |
661 | } |
618 | |
662 | |
619 | sub fmt_cb { |
663 | sub fmt_cb { |
620 | my ($ctx, $cb) = @_; |
664 | my ($ctx, $cb) = @_; |
621 | |
665 | |