| … | |
… | |
| 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 | |
