ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent/Log.pm
(Generate patch)

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents):
Revision 1.2 by root, Tue Aug 16 14:47:27 2011 UTC vs.
Revision 1.22 by root, Sun Aug 21 02:19:30 2011 UTC

2 2
3AnyEvent::Log - simple logging "framework" 3AnyEvent::Log - simple logging "framework"
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 # simple use
8 use AnyEvent;
9
10 AE::log debug => "hit my knee";
11 AE::log warn => "it's a bit too hot";
12 AE::log error => "the flag was false!";
13 AE::log fatal => "the bit toggled! run!";
14
15 # "complex" use
7 use AnyEvent::Log; 16 use AnyEvent::Log;
17
18 my $tracer = AnyEvent::Log::logger trace => \$my $trace;
19
20 $tracer->("i am here") if $trace;
21 $tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
22
23 # configuration
24
25 # set logging for the current package to errors and higher only
26 AnyEvent::Log::ctx->level ("error");
27
28 # set logging globally to anything below debug
29 $AnyEvent::Log::FILTER->level ("notice");
30
31 # see also EXAMPLES, below
8 32
9=head1 DESCRIPTION 33=head1 DESCRIPTION
10 34
11This module implements a relatively simple "logging framework". It doesn't 35This module implements a relatively simple "logging framework". It doesn't
12attempt to be "the" logging solution or even "a" logging solution for 36attempt to be "the" logging solution or even "a" logging solution for
13AnyEvent - AnyEvent simply creates logging messages internally, and this 37AnyEvent - AnyEvent simply creates logging messages internally, and this
14module more or less exposes the mechanism, with some extra spiff to allow 38module more or less exposes the mechanism, with some extra spiff to allow
15using it from other modules as well. 39using it from other modules as well.
16 40
17Remember that the default verbosity level is C<0>, so nothing 41Remember that the default verbosity level is C<0> (C<off>), so nothing
18will be logged, ever, unless you set C<$Anyvent::VERBOSE> or 42will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
19C<PERL_ANYEVENT_VERBOSE> to a higher number. 43before starting your program, or change the logging level at runtime with
44something like:
20 45
21Possible future extensions are to allow custom log targets (where the 46 use AnyEvent::Log;
22level is an object), log filtering based on package, formatting, aliasing 47 AnyEvent::Log::FILTER->level ("info");
23or package groups.
24 48
49The design goal behind this module was to keep it simple (and small),
50but make it powerful enough to be potentially useful for any module, and
51extensive enough for the most common tasks, such as logging to multiple
52targets, or being able to log into a database.
53
54The amount of documentation might indicate otherwise, but the module is
55still just below 300 lines of code.
56
57=head1 LOGGING LEVELS
58
59Logging levels in this module range from C<1> (highest priority) to C<9>
60(lowest priority). Note that the lowest numerical value is the highest
61priority, so when this document says "higher priority" it means "lower
62numerical value".
63
64Instead of specifying levels by name you can also specify them by aliases:
65
66 LVL NAME SYSLOG PERL NOTE
67 1 fatal emerg exit aborts program!
68 2 alert
69 3 critical crit
70 4 error err die
71 5 warn warning
72 6 note notice
73 7 info
74 8 debug
75 9 trace
76
77As you can see, some logging levels have multiple aliases - the first one
78is the "official" name, the second one the "syslog" name (if it differs)
79and the third one the "perl" name, suggesting that you log C<die> messages
80at C<error> priority.
81
82You can normally only log a single message at highest priority level
83(C<1>, C<fatal>), because logging a fatal message will also quit the
84program - so use it sparingly :)
85
86Some methods also offer some extra levels, such as C<0>, C<off>, C<none>
87or C<all> - these are only valid in the methods they are documented for.
88
25=head1 LOG FUNCTIONS 89=head1 LOGGING FUNCTIONS
26 90
27These functions allow you to log messages. They always use the caller's 91These functions allow you to log messages. They always use the caller's
28package as a "logging module/source". Also, The main logging function is 92package as a "logging context". Also, the main logging function C<log> is
29easily available as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> 93callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is
30module is loaded. 94loaded.
31 95
32=over 4 96=over 4
33 97
34=cut 98=cut
35 99
37 101
38use Carp (); 102use Carp ();
39use POSIX (); 103use POSIX ();
40 104
41use AnyEvent (); BEGIN { AnyEvent::common_sense } 105use AnyEvent (); BEGIN { AnyEvent::common_sense }
106use AnyEvent::Util ();
107
108our $VERSION = $AnyEvent::VERSION;
109
110our ($COLLECT, $FILTER, $LOG);
42 111
43our ($now_int, $now_str1, $now_str2); 112our ($now_int, $now_str1, $now_str2);
44 113
45# Format Time, not public - yet? 114# Format Time, not public - yet?
46sub ft($) { 115sub ft($) {
51 if $now_int != $i; 120 if $now_int != $i;
52 121
53 "$now_str1$f$now_str2" 122 "$now_str1$f$now_str2"
54} 123}
55 124
125our %CTX; # all package contexts
126
127# creates a default package context object for the given package
128sub _pkg_ctx($) {
129 my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx";
130
131 # link "parent" package
132 my $parent = $_[0] =~ /^(.+)::/
133 ? $CTX{$1} ||= &_pkg_ctx ("$1")
134 : $COLLECT;
135
136 $ctx->[2]{$parent+0} = $parent;
137
138 $ctx
139}
140
56=item AnyEvent::Log::log $level, $msg[, @args] 141=item AnyEvent::Log::log $level, $msg[, @args]
57 142
58Requests logging of the given C<$msg> with the given log level (1..9). 143Requests logging of the given C<$msg> with the given log level, and
59You can also use the following strings as log level: C<fatal> (1), 144returns true if the message was logged I<somewhere>.
60C<alert> (2), C<critical> (3), C<error> (4), C<warn> (5), C<note> (6),
61C<info> (7), C<debug> (8), C<trace> (9).
62 145
63For C<fatal> log levels, the program will abort. 146For C<fatal> log levels, the program will abort.
64 147
65If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the 148If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the
66C<$msg> is interpreted as an sprintf format string. 149C<$msg> is interpreted as an sprintf format string.
67 150
68The C<$msg> should not end with C<\n>, but may if that is convenient for 151The C<$msg> should not end with C<\n>, but may if that is convenient for
69you. Also, multiline messages are handled properly. 152you. Also, multiline messages are handled properly.
70 153
71In addition, for possible future expansion, C<$msg> must not start with an 154Last not least, C<$msg> might be a code reference, in which case it is
72angle bracket (C<< < >>). 155supposed to return the message. It will be called only then the message
156actually gets logged, which is useful if it is costly to create the
157message in the first place.
73 158
74Whether the given message will be logged depends on the maximum log level 159Whether the given message will be logged depends on the maximum log level
75and the caller's package. 160and the caller's package. The return value can be used to ensure that
161messages or not "lost" - for example, when L<AnyEvent::Debug> detects a
162runtime error it tries to log it at C<die> level, but if that message is
163lost it simply uses warn.
76 164
77Note that you can (and should) call this function as C<AnyEvent::log> or 165Note that you can (and should) call this function as C<AnyEvent::log> or
78C<AE::log>, without C<use>-ing this module if possible, as those functions 166C<AE::log>, without C<use>-ing this module if possible (i.e. you don't
79will laod the logging module on demand only. 167need any additional functionality), as those functions will load the
168logging module on demand only. They are also much shorter to write.
169
170Also, if you optionally generate a lot of debug messages (such as when
171tracing some code), you should look into using a logger callback and a
172boolean enabler (see C<logger>, below).
173
174Example: log something at error level.
175
176 AE::log error => "something";
177
178Example: use printf-formatting.
179
180 AE::log info => "%5d %-10.10s %s", $index, $category, $msg;
181
182Example: only generate a costly dump when the message is actually being logged.
183
184 AE::log debug => sub { require Data::Dump; Data::Dump::dump \%cache };
80 185
81=cut 186=cut
82 187
83# also allow syslog equivalent names 188# also allow syslog equivalent names
84our %STR2LEVEL = ( 189our %STR2LEVEL = (
85 fatal => 1, emerg => 1, 190 fatal => 1, emerg => 1, exit => 1,
86 alert => 2, 191 alert => 2,
87 critical => 3, crit => 3, 192 critical => 3, crit => 3,
88 error => 4, err => 4, 193 error => 4, err => 4, die => 4,
89 warn => 5, warning => 5, 194 warn => 5, warning => 5,
90 note => 6, notice => 6, 195 note => 6, notice => 6,
91 info => 7, 196 info => 7,
92 debug => 8, 197 debug => 8,
93 trace => 9, 198 trace => 9,
94); 199);
95 200
201sub now () { time }
202
203AnyEvent::post_detect {
204 *now = \&AE::now;
205};
206
96our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace); 207our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
97 208
209# time, ctx, level, msg
210sub _format($$$$) {
211 my $ts = ft $_[0];
212 my $ct = " ";
213
214 my @res;
215
216 for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) {
217 push @res, "$ts$ct$_\n";
218 $ct = " + ";
219 }
220
221 join "", @res
222}
223
224sub _log {
225 my ($ctx, $level, $format, @args) = @_;
226
227 $level = $level > 0 && $level <= 9
228 ? $level+0
229 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
230
231 my $mask = 1 << $level;
232
233 my ($success, %seen, @ctx, $now, $fmt);
234
235 do
236 {
237 # skip if masked
238 if ($ctx->[1] & $mask && !$seen{$ctx+0}++) {
239 if ($ctx->[3]) {
240 # logging target found
241
242 # now get raw message, unless we have it already
243 unless ($now) {
244 $format = $format->() if ref $format;
245 $format = sprintf $format, @args if @args;
246 $format =~ s/\n$//;
247 $now = AE::now;
248 };
249
250 # format msg
251 my $str = $ctx->[4]
252 ? $ctx->[4]($now, $_[0], $level, $format)
253 : ($fmt ||= _format $now, $_[0], $level, $format);
254
255 $success = 1;
256
257 $ctx->[3]($str)
258 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
259 } else {
260 push @ctx, values %{ $ctx->[2] }; # not masked - propagate
261 }
262 }
263 }
264 while $ctx = pop @ctx;
265
266 exit 1 if $level <= 1;
267
268 $success
269}
270
98sub log($$;@) { 271sub log($$;@) {
99 my ($targ, $msg, @args) = @_; 272 _log
273 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
274 @_;
275}
100 276
101 my $level = ref $targ ? die "Can't use reference as logging level (yet)" 277*AnyEvent::log = *AE::log = \&log;
102 : $targ > 0 && $targ <= 9 ? $targ+0
103 : $STR2LEVEL{$targ} || Carp::croak "$targ: not a valid logging level, caught";
104 278
105 return if $level > $AnyEvent::VERBOSE; 279=item $logger = AnyEvent::Log::logger $level[, \$enabled]
106 280
107 my $pkg = (caller)[0]; 281Creates a code reference that, when called, acts as if the
282C<AnyEvent::Log::log> function was called at this point with the given
283level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
284the C<AnyEvent::Log::log> function:
108 285
109 $msg = sprintf $msg, @args if @args; 286 my $debug_log = AnyEvent::Log::logger "debug";
110 $msg =~ s/\n$//;
111 287
112 # now we have a message, log it 288 $debug_log->("debug here");
113 #TODO: could do LOTS of stuff here, and should, at least in some later version 289 $debug_log->("%06d emails processed", 12345);
290 $debug_log->(sub { $obj->as_string });
114 291
115 $msg = sprintf "%5s (%s) %s", $LEVEL2STR[$level], $pkg, $msg; 292The idea behind this function is to decide whether to log before actually
116 my $pfx = ft AE::now; 293logging - when the C<logger> function is called once, but the returned
294logger callback often, then this can be a tremendous speed win.
117 295
118 for (split /\n/, $msg) { 296Despite this speed advantage, changes in logging configuration will
119 printf STDERR "$pfx $_\n"; 297still be reflected by the logger callback, even if configuration changes
120 $pfx = "\t"; 298I<after> it was created.
299
300To further speed up logging, you can bind a scalar variable to the logger,
301which contains true if the logger should be called or not - if it is
302false, calling the logger can be safely skipped. This variable will be
303updated as long as C<$logger> is alive.
304
305Full example:
306
307 # near the init section
308 use AnyEvent::Log;
309
310 my $debug_log = AnyEvent:Log::logger debug => \my $debug;
311
312 # and later in your program
313 $debug_log->("yo, stuff here") if $debug;
314
315 $debug and $debug_log->("123");
316
317=cut
318
319our %LOGGER;
320
321# re-assess logging status for all loggers
322sub _reassess {
323 local $SIG{__DIE__};
324 my $die = sub { die };
325
326 for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
327 my ($ctx, $level, $renabled) = @$_;
328
329 # to detect whether a message would be logged, we actually
330 # try to log one and die. this isn't fast, but we can be
331 # sure that the logging decision is correct :)
332
333 $$renabled = !eval {
334 _log $ctx, $level, $die;
335
336 1
337 };
121 } 338 }
122
123 exit 1 if $level <= 1;
124} 339}
125 340
126*AnyEvent::log = *AE::log = \&log; 341sub _logger {
342 my ($ctx, $level, $renabled) = @_;
127 343
128#TODO 344 $$renabled = 1;
345
346 my $logger = [$ctx, $level, $renabled];
347
348 $LOGGER{$logger+0} = $logger;
349
350 _reassess $logger+0;
351
352 my $guard = AnyEvent::Util::guard {
353 # "clean up"
354 delete $LOGGER{$logger+0};
355 };
356
357 sub {
358 $guard if 0; # keep guard alive, but don't cause runtime overhead
359
360 _log $ctx, $level, @_
361 if $$renabled;
362 }
363}
364
365sub logger($;$) {
366 _logger
367 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
368 @_
369}
129 370
130=back 371=back
131 372
132=head1 CONFIGURATION FUNCTIONALITY 373=head1 LOGGING CONTEXTS
133 374
134None, yet, except for C<PERL_ANYEVENT_VERBOSE>, described in the L<AnyEvent> manpage. 375This module associates every log message with a so-called I<logging
376context>, based on the package of the caller. Every perl package has its
377own logging context.
378
379A logging context has three major responsibilities: filtering, logging and
380propagating the message.
381
382For the first purpose, filtering, each context has a set of logging
383levels, called the log level mask. Messages not in the set will be ignored
384by this context (masked).
385
386For logging, the context stores a formatting callback (which takes the
387timestamp, context, level and string message and formats it in the way
388it should be logged) and a logging callback (which is responsible for
389actually logging the formatted message and telling C<AnyEvent::Log>
390whether it has consumed the message, or whether it should be propagated).
391
392For propagation, a context can have any number of attached I<slave
393contexts>. Any message that is neither masked by the logging mask nor
394masked by the logging callback returning true will be passed to all slave
395contexts.
396
397Each call to a logging function will log the message at most once per
398context, so it does not matter (much) if there are cycles or if the
399message can arrive at the same context via multiple paths.
400
401=head2 DEFAULTS
402
403By default, all logging contexts have an full set of log levels ("all"), a
404disabled logging callback and the default formatting callback.
405
406Package contexts have the package name as logging title by default.
407
408They have exactly one slave - the context of the "parent" package. The
409parent package is simply defined to be the package name without the last
410component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>,
411and C<AnyEvent> becomes ... C<$AnyEvent::Log::COLLECT> which is the
412exception of the rule - just like the "parent" of any single-component
413package name in Perl is C<main>, the default slave of any top-level
414package context is C<$AnyEvent::Log::COLLECT>.
415
416Since perl packages form only an approximate hierarchy, this slave
417context can of course be removed.
418
419All other (anonymous) contexts have no slaves and an empty title by
420default.
421
422When the module is loaded it creates the C<$AnyEvent::Log::LOG> logging
423context that simply logs everything via C<warn>, without propagating
424anything anywhere by default. The purpose of this context is to provide
425a convenient place to override the global logging target or to attach
426additional log targets. It's not meant for filtering.
427
428It then creates the C<$AnyEvent::Log::FILTER> context whose
429purpose is to suppress all messages with priority higher
430than C<$ENV{PERL_ANYEVENT_VERBOSE}>. It then attached the
431C<$AnyEvent::Log::LOG> context to it. The purpose of the filter context
432is to simply provide filtering according to some global log level.
433
434Finally it creates the top-level package context C<$AnyEvent::Log::COLLECT>
435and attaches the C<$AnyEvent::Log::FILTER> context to it, but otherwise
436leaves it at default config. Its purpose is simply to collect all log
437messages system-wide.
438
439The hierarchy is then:
440
441 any package, eventually -> $COLLECT -> $FILTER -> $LOG
442
443The effect of all this is that log messages, by default, wander up to the
444C<$AnyEvent::Log::COLLECT> context where all messages normally end up,
445from there to C<$AnyEvent::Log::FILTER> where log messages with lower
446priority then C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered out and then
447to the C<$AnyEvent::Log::LOG> context to be passed to C<warn>.
448
449This makes it easy to set a global logging level (by modifying $FILTER),
450but still allow other contexts to send, for example, their debug and trace
451messages to the $LOG target despite the global logging level, or to attach
452additional log targets that log messages, regardless of the global logging
453level.
454
455It also makes it easy to modify the default warn-logger ($LOG) to
456something that logs to a file, or to attach additional logging targets
457(such as loggign to a file) by attaching it to $FILTER.
458
459=head2 CREATING/FINDING/DESTROYING CONTEXTS
135 460
136=over 4 461=over 4
137 462
463=item $ctx = AnyEvent::Log::ctx [$pkg]
464
465This function creates or returns a logging context (which is an object).
466
467If a package name is given, then the context for that packlage is
468returned. If it is called without any arguments, then the context for the
469callers package is returned (i.e. the same context as a C<AE::log> call
470would use).
471
472If C<undef> is given, then it creates a new anonymous context that is not
473tied to any package and is destroyed when no longer referenced.
474
138=cut 475=cut
476
477sub ctx(;$) {
478 my $pkg = @_ ? shift : (caller)[0];
479
480 ref $pkg
481 ? $pkg
482 : defined $pkg
483 ? $CTX{$pkg} ||= AnyEvent::Log::_pkg_ctx $pkg
484 : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx"
485}
486
487=item AnyEvent::Log::reset
488
489Resets all package contexts and recreates the default hierarchy if
490necessary, i.e. resets the logging subsystem to defaults, as much as
491possible. This process keeps references to contexts held by other parts of
492the program intact.
493
494This can be used to implement config-file (re-)loading: before loading a
495configuration, reset all contexts.
496
497=cut
498
499sub reset {
500 # hard to kill complex data structures
501 # we "recreate" all package loggers and reset the hierarchy
502 while (my ($k, $v) = each %CTX) {
503 @$v = ($k, (1 << 10) - 1 - 1, { });
504
505 $v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log::COLLECT);
506 }
507
508 @$_ = ($_->[0], (1 << 10) - 1 - 1)
509 for $LOG, $FILTER, $COLLECT;
510
511 $LOG->slaves;
512 $LOG->title ('$AnyEvent::Log::LOG');
513 $LOG->log_cb (sub {
514 warn shift;
515 0
516 });
517
518 $FILTER->slaves ($LOG);
519 $FILTER->title ('$AnyEvent::Log::FILTER');
520 $FILTER->level ($AnyEvent::VERBOSE);
521
522 $COLLECT->slaves ($FILTER);
523 $COLLECT->title ('$AnyEvent::Log::COLLECT');
524
525 _reassess;
526}
527
528# create the default logger contexts
529$LOG = ctx undef;
530$FILTER = ctx undef;
531$COLLECT = ctx undef;
532
533AnyEvent::Log::reset;
534
535# hello, CPAN, please catch me
536package AnyEvent::Log::LOG;
537package AE::Log::LOG;
538package AnyEvent::Log::FILTER;
539package AE::Log::FILTER;
540package AnyEvent::Log::COLLECT;
541package AE::Log::COLLECT;
542
543package AnyEvent::Log::Ctx;
544
545# 0 1 2 3 4
546# [$title, $level, %$slaves, &$logcb, &$fmtcb]
547
548=item $ctx = new AnyEvent::Log::Ctx methodname => param...
549
550This is a convenience constructor that makes it simpler to construct
551anonymous logging contexts.
552
553Each key-value pair results in an invocation of the method of the same
554name as the key with the value as parameter, unless the value is an
555arrayref, in which case it calls the method with the contents of the
556array. The methods are called in the same order as specified.
557
558Example: create a new logging context and set both the default logging
559level, some slave contexts and a logging callback.
560
561 $ctx = new AnyEvent::Log::Ctx
562 title => "dubious messages",
563 level => "error",
564 log_cb => sub { print STDOUT shift; 0 },
565 slaves => [$ctx1, $ctx, $ctx2],
566 ;
567
568=back
569
570=cut
571
572sub new {
573 my $class = shift;
574
575 my $ctx = AnyEvent::Log::ctx undef;
576
577 while (@_) {
578 my ($k, $v) = splice @_, 0, 2;
579 $ctx->$k (ref $v eq "ARRAY" ? @$v : $v);
580 }
581
582 bless $ctx, $class # do we really support subclassing, hmm?
583}
584
585
586=head2 CONFIGURING A LOG CONTEXT
587
588The following methods can be used to configure the logging context.
589
590=over 4
591
592=item $ctx->title ([$new_title])
593
594Returns the title of the logging context - this is the package name, for
595package contexts, and a user defined string for all others.
596
597If C<$new_title> is given, then it replaces the package name or title.
598
599=cut
600
601sub title {
602 $_[0][0] = $_[1] if @_ > 1;
603 $_[0][0]
604}
605
606=back
607
608=head3 LOGGING LEVELS
609
610The following methods deal with the logging level set associated with the
611log context.
612
613The most common method to use is probably C<< $ctx->level ($level) >>,
614which configures the specified and any higher priority levels.
615
616All functions which accept a list of levels also accept the special string
617C<all> which expands to all logging levels.
618
619=over 4
620
621=item $ctx->levels ($level[, $level...)
622
623Enables logging for the given levels and disables it for all others.
624
625=item $ctx->level ($level)
626
627Enables logging for the given level and all lower level (higher priority)
628ones. In addition to normal logging levels, specifying a level of C<0> or
629C<off> disables all logging for this level.
630
631Example: log warnings, errors and higher priority messages.
632
633 $ctx->level ("warn");
634 $ctx->level (5); # same thing, just numeric
635
636=item $ctx->enable ($level[, $level...])
637
638Enables logging for the given levels, leaving all others unchanged.
639
640=item $ctx->disable ($level[, $level...])
641
642Disables logging for the given levels, leaving all others unchanged.
643
644=cut
645
646sub _lvl_lst {
647 map {
648 $_ > 0 && $_ <= 9 ? $_+0
649 : $_ eq "all" ? (1 .. 9)
650 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
651 } @_
652}
653
654our $NOP_CB = sub { 0 };
655
656sub levels {
657 my $ctx = shift;
658 $ctx->[1] = 0;
659 $ctx->[1] |= 1 << $_
660 for &_lvl_lst;
661 AnyEvent::Log::_reassess;
662}
663
664sub level {
665 my $ctx = shift;
666 my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
667
668 $ctx->[1] = ((1 << $lvl) - 1) << 1;
669 AnyEvent::Log::_reassess;
670}
671
672sub enable {
673 my $ctx = shift;
674 $ctx->[1] |= 1 << $_
675 for &_lvl_lst;
676 AnyEvent::Log::_reassess;
677}
678
679sub disable {
680 my $ctx = shift;
681 $ctx->[1] &= ~(1 << $_)
682 for &_lvl_lst;
683 AnyEvent::Log::_reassess;
684}
685
686=back
687
688=head3 SLAVE CONTEXTS
689
690The following methods attach and detach another logging context to a
691logging context.
692
693Log messages are propagated to all slave contexts, unless the logging
694callback consumes the message.
695
696=over 4
697
698=item $ctx->attach ($ctx2[, $ctx3...])
699
700Attaches the given contexts as slaves to this context. It is not an error
701to add a context twice (the second add will be ignored).
702
703A context can be specified either as package name or as a context object.
704
705=item $ctx->detach ($ctx2[, $ctx3...])
706
707Removes the given slaves from this context - it's not an error to attempt
708to remove a context that hasn't been added.
709
710A context can be specified either as package name or as a context object.
711
712=item $ctx->slaves ($ctx2[, $ctx3...])
713
714Replaces all slaves attached to this context by the ones given.
715
716=cut
717
718sub attach {
719 my $ctx = shift;
720
721 $ctx->[2]{$_+0} = $_
722 for map { AnyEvent::Log::ctx $_ } @_;
723}
724
725sub detach {
726 my $ctx = shift;
727
728 delete $ctx->[2]{$_+0}
729 for map { AnyEvent::Log::ctx $_ } @_;
730}
731
732sub slaves {
733 undef $_[0][2];
734 &attach;
735}
736
737=back
738
739=head3 LOG TARGETS
740
741The following methods configure how the logging context actually does
742the logging (which consists of formatting the message and printing it or
743whatever it wants to do with it).
744
745=over 4
746
747=item $ctx->log_cb ($cb->($str)
748
749Replaces the logging callback on the context (C<undef> disables the
750logging callback).
751
752The logging callback is responsible for handling formatted log messages
753(see C<fmt_cb> below) - normally simple text strings that end with a
754newline (and are possibly multiline themselves).
755
756It also has to return true iff it has consumed the log message, and false
757if it hasn't. Consuming a message means that it will not be sent to any
758slave context. When in doubt, return C<0> from your logging callback.
759
760Example: a very simple logging callback, simply dump the message to STDOUT
761and do not consume it.
762
763 $ctx->log_cb (sub { print STDERR shift; 0 });
764
765You can filter messages by having a log callback that simply returns C<1>
766and does not do anything with the message, but this counts as "message
767being logged" and might not be very efficient.
768
769Example: propagate all messages except for log levels "debug" and
770"trace". The messages will still be generated, though, which can slow down
771your program.
772
773 $ctx->levels ("debug", "trace");
774 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
775
776=item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
777
778Replaces the formatting callback on the context (C<undef> restores the
779default formatter).
780
781The callback is passed the (possibly fractional) timestamp, the original
782logging context, the (numeric) logging level and the raw message string
783and needs to return a formatted log message. In most cases this will be a
784string, but it could just as well be an array reference that just stores
785the values.
786
787If, for some reaosn, you want to use C<caller> to find out more baout the
788logger then you should walk up the call stack until you are no longer
789inside the C<AnyEvent::Log> package.
790
791Example: format just the raw message, with numeric log level in angle
792brackets.
793
794 $ctx->fmt_cb (sub {
795 my ($time, $ctx, $lvl, $msg) = @_;
796
797 "<$lvl>$msg\n"
798 });
799
800Example: return an array reference with just the log values, and use
801C<PApp::SQL::sql_exec> to store the emssage in a database.
802
803 $ctx->fmt_cb (sub { \@_ });
804 $ctx->log_cb (sub {
805 my ($msg) = @_;
806
807 sql_exec "insert into log (when, subsys, prio, msg) values (?, ?, ?, ?)",
808 $msg->[0] + 0,
809 "$msg->[1]",
810 $msg->[2] + 0,
811 "$msg->[3]";
812
813 0
814 });
815
816=item $ctx->log_to_file ($path)
817
818Sets the C<log_cb> to log to a file (by appending), unbuffered.
819
820=item $ctx->log_to_path ($path)
821
822Same as C<< ->log_to_file >>, but opens the file for each message. This
823is much slower, but allows you to change/move/rename/delete the file at
824basically any time.
825
826=item $ctx->log_to_syslog ([$log_flags])
827
828Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and all
829the others in the obvious way. If specified, then the C<$log_flags> are
830simply or'ed onto the priority argument and can contain any C<LOG_xxx>
831flags valid for Sys::Syslog::syslog, except for the priority levels.
832
833Note that this function also sets a C<fmt_cb> - the logging part requires
834an array reference with [$level, $str] as input.
835
836=cut
837
838sub log_cb {
839 my ($ctx, $cb) = @_;
840
841 $ctx->[3] = $cb;
842}
843
844sub fmt_cb {
845 my ($ctx, $cb) = @_;
846
847 $ctx->[4] = $cb;
848}
849
850sub log_to_file {
851 my ($ctx, $path) = @_;
852
853 open my $fh, ">>", $path
854 or die "$path: $!";
855
856 $ctx->log_cb (sub {
857 syswrite $fh, shift;
858 0
859 });
860}
861
862sub log_to_file {
863 my ($ctx, $path) = @_;
864
865 $ctx->log_cb (sub {
866 open my $fh, ">>", $path
867 or die "$path: $!";
868
869 syswrite $fh, shift;
870 0
871 });
872}
873
874sub log_to_syslog {
875 my ($ctx, $flags) = @_;
876
877 require Sys::Syslog;
878
879 $ctx->fmt_cb (sub {
880 my $str = $_[3];
881 $str =~ s/\n(?=.)/\n+ /g;
882
883 [$_[2], "($_[1][0]) $str"]
884 });
885
886 $ctx->log_cb (sub {
887 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
888
889 Sys::Syslog::syslog ($flags | ($lvl - 1), $_)
890 for split /\n/, $_[0][1];
891
892 0
893 });
894}
895
896=back
897
898=head3 MESSAGE LOGGING
899
900These methods allow you to log messages directly to a context, without
901going via your package context.
902
903=over 4
904
905=item $ctx->log ($level, $msg[, @params])
906
907Same as C<AnyEvent::Log::log>, but uses the given context as log context.
908
909=item $logger = $ctx->logger ($level[, \$enabled])
910
911Same as C<AnyEvent::Log::logger>, but uses the given context as log
912context.
913
914=cut
915
916*log = \&AnyEvent::Log::_log;
917*logger = \&AnyEvent::Log::_logger;
139 918
1401; 9191;
920
921=back
922
923=head1 EXAMPLES
924
925This section shows some common configurations.
926
927=over 4
928
929=item Setting the global logging level.
930
931Either put PERL_ANYEVENT_VERBOSE=<number> into your environment before
932running your program, or modify the log level of the root context:
933
934 PERL_ANYEVENT_VERBOSE=5 ./myprog
935
936 $AnyEvent::Log::FILTER->level ("warn");
937
938=item Append all messages to a file instead of sending them to STDERR.
939
940This is affected by the global logging level.
941
942 $AnyEvent::Log::LOG->log_to_file ($path); (sub {
943
944=item Write all messages with priority C<error> and higher to a file.
945
946This writes them only when the global logging level allows it, because
947it is attached to the default context which is invoked I<after> global
948filtering.
949
950 $AnyEvent::Log::FILTER->attach
951 new AnyEvent::Log::Ctx log_to_file => $path);
952
953This writes them regardless of the global logging level, because it is
954attached to the toplevel context, which receives all messages I<before>
955the global filtering.
956
957 $AnyEvent::Log::COLLECT->attach (
958 new AnyEvent::Log::Ctx log_to_file => $path);
959
960In both cases, messages are still written to STDERR.
961
962=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
963
964Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
965context - this simply circumvents the global filtering for trace messages.
966
967 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
968 $debug->attach ($AnyEvent::Log::LOG);
969
970This of course works for any package, not just L<AnyEvent::Debug>, but
971assumes the log level for AnyEvent::Debug hasn't been changed from the
972default.
141 973
142=back 974=back
143 975
144=head1 AUTHOR 976=head1 AUTHOR
145 977

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines