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.8 by root, Fri Aug 19 19:20:36 2011 UTC vs.
Revision 1.18 by root, Sat Aug 20 15:57:35 2011 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines