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.11 by root, Sat Aug 20 01:03:09 2011 UTC vs.
Revision 1.22 by root, Sun Aug 21 02:19:30 2011 UTC

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 # configuration 23 # configuration
24 24
25 # set logging for this package to maximum 25 # set logging for the current package to errors and higher only
26 AnyEvent::Log::ctx->level ("all"); 26 AnyEvent::Log::ctx->level ("error");
27 27
28 # set logging globally to anything below debug 28 # set logging globally to anything below debug
29 (AnyEvent::Log::ctx "")->level ("notice"); 29 $AnyEvent::Log::FILTER->level ("notice");
30 30
31 # see also EXAMPLES, below 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);
40 32
41=head1 DESCRIPTION 33=head1 DESCRIPTION
42 34
43This module implements a relatively simple "logging framework". It doesn't 35This module implements a relatively simple "logging framework". It doesn't
44attempt to be "the" logging solution or even "a" logging solution for 36attempt to be "the" logging solution or even "a" logging solution for
45AnyEvent - AnyEvent simply creates logging messages internally, and this 37AnyEvent - AnyEvent simply creates logging messages internally, and this
46module 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
47using it from other modules as well. 39using it from other modules as well.
48 40
49Remember that the default verbosity level is C<0>, so nothing will be 41Remember that the default verbosity level is C<0> (C<off>), so nothing
50logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number before 42will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
51starting your program, or change the logging level at runtime with 43before starting your program, or change the logging level at runtime with
52something like: 44something like:
53 45
54 use AnyEvent; 46 use AnyEvent::Log;
55 (AnyEvent::Log::ctx "")->level ("info"); 47 AnyEvent::Log::FILTER->level ("info");
56 48
57The design goal behind this module was to keep it simple (and small), 49The design goal behind this module was to keep it simple (and small),
58but make it powerful enough to be potentially useful for any module, and 50but make it powerful enough to be potentially useful for any module, and
59extensive enough for the most common tasks, such as logging to multiple 51extensive enough for the most common tasks, such as logging to multiple
60targets, or being able to log into a database. 52targets, or being able to log into a database.
61 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
62=head1 LOGGING FUNCTIONS 89=head1 LOGGING FUNCTIONS
63 90
64These 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
65package as a "logging module/source". Also, the main logging function is 92package as a "logging context". Also, the main logging function C<log> is
66callable 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
67loaded. 94loaded.
68 95
69=over 4 96=over 4
70 97
75use Carp (); 102use Carp ();
76use POSIX (); 103use POSIX ();
77 104
78use AnyEvent (); BEGIN { AnyEvent::common_sense } 105use AnyEvent (); BEGIN { AnyEvent::common_sense }
79use AnyEvent::Util (); 106use AnyEvent::Util ();
107
108our $VERSION = $AnyEvent::VERSION;
109
110our ($COLLECT, $FILTER, $LOG);
80 111
81our ($now_int, $now_str1, $now_str2); 112our ($now_int, $now_str1, $now_str2);
82 113
83# Format Time, not public - yet? 114# Format Time, not public - yet?
84sub ft($) { 115sub ft($) {
89 if $now_int != $i; 120 if $now_int != $i;
90 121
91 "$now_str1$f$now_str2" 122 "$now_str1$f$now_str2"
92} 123}
93 124
94our %CTX; # all logging contexts 125our %CTX; # all package contexts
95 126
96# creates a default package context object for the given package 127# creates a default package context object for the given package
97sub _pkg_ctx($) { 128sub _pkg_ctx($) {
98 my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx"; 129 my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx";
99 130
100 # link "parent" package 131 # link "parent" package
101 my $pkg = $_[0] =~ /^(.+)::/ ? $1 : "AE::Log::Top"; 132 my $parent = $_[0] =~ /^(.+)::/
133 ? $CTX{$1} ||= &_pkg_ctx ("$1")
134 : $COLLECT;
102 135
103 $pkg = $CTX{$pkg} ||= &_pkg_ctx ($pkg);
104 $ctx->[2]{$pkg+0} = $pkg; 136 $ctx->[2]{$parent+0} = $parent;
105 137
106 $ctx 138 $ctx
107} 139}
108 140
109=item AnyEvent::Log::log $level, $msg[, @args] 141=item AnyEvent::Log::log $level, $msg[, @args]
110 142
111Requests 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
112You can also use the following strings as log level: C<fatal> (1), 144returns true if the message was logged I<somewhere>.
113C<alert> (2), C<critical> (3), C<error> (4), C<warn> (5), C<note> (6),
114C<info> (7), C<debug> (8), C<trace> (9).
115 145
116For C<fatal> log levels, the program will abort. 146For C<fatal> log levels, the program will abort.
117 147
118If 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
119C<$msg> is interpreted as an sprintf format string. 149C<$msg> is interpreted as an sprintf format string.
125supposed to return the message. It will be called only then the message 155supposed to return the message. It will be called only then the message
126actually gets logged, which is useful if it is costly to create the 156actually gets logged, which is useful if it is costly to create the
127message in the first place. 157message in the first place.
128 158
129Whether 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
130and 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.
131 164
132Note 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
133C<AE::log>, without C<use>-ing this module if possible (i.e. you don't 166C<AE::log>, without C<use>-ing this module if possible (i.e. you don't
134need any additional functionality), as those functions will load the 167need any additional functionality), as those functions will load the
135logging module on demand only. They are also much shorter to write. 168logging module on demand only. They are also much shorter to write.
152 185
153=cut 186=cut
154 187
155# also allow syslog equivalent names 188# also allow syslog equivalent names
156our %STR2LEVEL = ( 189our %STR2LEVEL = (
157 fatal => 1, emerg => 1, 190 fatal => 1, emerg => 1, exit => 1,
158 alert => 2, 191 alert => 2,
159 critical => 3, crit => 3, 192 critical => 3, crit => 3,
160 error => 4, err => 4, 193 error => 4, err => 4, die => 4,
161 warn => 5, warning => 5, 194 warn => 5, warning => 5,
162 note => 6, notice => 6, 195 note => 6, notice => 6,
163 info => 7, 196 info => 7,
164 debug => 8, 197 debug => 8,
165 trace => 9, 198 trace => 9,
195 ? $level+0 228 ? $level+0
196 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; 229 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
197 230
198 my $mask = 1 << $level; 231 my $mask = 1 << $level;
199 232
200 my (%seen, @ctx, $now, $fmt); 233 my ($success, %seen, @ctx, $now, $fmt);
201 234
202 do 235 do
203 { 236 {
204 # skip if masked 237 # skip if masked
205 if ($ctx->[1] & $mask && !$seen{$ctx+0}++) { 238 if ($ctx->[1] & $mask && !$seen{$ctx+0}++) {
215 }; 248 };
216 249
217 # format msg 250 # format msg
218 my $str = $ctx->[4] 251 my $str = $ctx->[4]
219 ? $ctx->[4]($now, $_[0], $level, $format) 252 ? $ctx->[4]($now, $_[0], $level, $format)
220 : $fmt ||= _format $now, $_[0], $level, $format; 253 : ($fmt ||= _format $now, $_[0], $level, $format);
221 254
255 $success = 1;
256
222 $ctx->[3]($str); 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
223 } 261 }
224
225 # not masked, not consumed - propagate to parent contexts
226 push @ctx, values %{ $ctx->[2] };
227 } 262 }
228 } 263 }
229 while $ctx = pop @ctx; 264 while $ctx = pop @ctx;
230 265
231 exit 1 if $level <= 1; 266 exit 1 if $level <= 1;
267
268 $success
232} 269}
233 270
234sub log($$;@) { 271sub log($$;@) {
235 _log 272 _log
236 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 273 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
240*AnyEvent::log = *AE::log = \&log; 277*AnyEvent::log = *AE::log = \&log;
241 278
242=item $logger = AnyEvent::Log::logger $level[, \$enabled] 279=item $logger = AnyEvent::Log::logger $level[, \$enabled]
243 280
244Creates a code reference that, when called, acts as if the 281Creates a code reference that, when called, acts as if the
245C<AnyEvent::Log::log> function was called at this point with the givne 282C<AnyEvent::Log::log> function was called at this point with the given
246level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with 283level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
247the C<AnyEvent::Log::log> function: 284the C<AnyEvent::Log::log> function:
248 285
249 my $debug_log = AnyEvent::Log::logger "debug"; 286 my $debug_log = AnyEvent::Log::logger "debug";
250 287
275 # and later in your program 312 # and later in your program
276 $debug_log->("yo, stuff here") if $debug; 313 $debug_log->("yo, stuff here") if $debug;
277 314
278 $debug and $debug_log->("123"); 315 $debug and $debug_log->("123");
279 316
280Note: currently the enabled var is always true - that will be fixed in a
281future version :)
282
283=cut 317=cut
284 318
285our %LOGGER; 319our %LOGGER;
286 320
287# re-assess logging status for all loggers 321# re-assess logging status for all loggers
288sub _reassess { 322sub _reassess {
323 local $SIG{__DIE__};
324 my $die = sub { die };
325
289 for (@_ ? $LOGGER{$_[0]} : values %LOGGER) { 326 for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
290 my ($ctx, $level, $renabled) = @$_; 327 my ($ctx, $level, $renabled) = @$_;
291 328
292 # to detect whether a message would be logged, we # actually 329 # to detect whether a message would be logged, we actually
293 # try to log one and die. this isn't fast, but we can be 330 # try to log one and die. this isn't fast, but we can be
294 # sure that the logging decision is correct :) 331 # sure that the logging decision is correct :)
295 332
296 $$renabled = !eval { 333 $$renabled = !eval {
297 local $SIG{__DIE__};
298
299 _log $ctx, $level, sub { die }; 334 _log $ctx, $level, $die;
300 335
301 1 336 1
302 }; 337 };
303
304 $$renabled = 1; # TODO
305 } 338 }
306} 339}
307 340
308sub _logger($;$) { 341sub _logger {
309 my ($ctx, $level, $renabled) = @_; 342 my ($ctx, $level, $renabled) = @_;
310
311 $renabled ||= \my $enabled;
312 343
313 $$renabled = 1; 344 $$renabled = 1;
314 345
315 my $logger = [$ctx, $level, $renabled]; 346 my $logger = [$ctx, $level, $renabled];
316 347
356timestamp, context, level and string message and formats it in the way 387timestamp, context, level and string message and formats it in the way
357it should be logged) and a logging callback (which is responsible for 388it should be logged) and a logging callback (which is responsible for
358actually logging the formatted message and telling C<AnyEvent::Log> 389actually logging the formatted message and telling C<AnyEvent::Log>
359whether it has consumed the message, or whether it should be propagated). 390whether it has consumed the message, or whether it should be propagated).
360 391
361For propagation, a context can have any number of attached I<parent 392For propagation, a context can have any number of attached I<slave
362contexts>. Any message that is neither masked by the logging mask nor 393contexts>. Any message that is neither masked by the logging mask nor
363masked by the logging callback returning true will be passed to all parent 394masked by the logging callback returning true will be passed to all slave
364contexts. 395contexts.
365 396
366Each call to a logging function will log the message at most once per 397Each call to a logging function will log the message at most once per
367context, so it does not matter (much) if there are cycles or if the 398context, so it does not matter (much) if there are cycles or if the
368message can arrive at the same context via multiple paths. 399message can arrive at the same context via multiple paths.
372By default, all logging contexts have an full set of log levels ("all"), a 403By default, all logging contexts have an full set of log levels ("all"), a
373disabled logging callback and the default formatting callback. 404disabled logging callback and the default formatting callback.
374 405
375Package contexts have the package name as logging title by default. 406Package contexts have the package name as logging title by default.
376 407
377They have exactly one parent - the context of the "parent" package. The 408They have exactly one slave - the context of the "parent" package. The
378parent package is simply defined to be the package name without the last 409parent package is simply defined to be the package name without the last
379component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>, 410component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>,
380and C<AnyEvent> becomes ... C<AnyEvent::Log::Top> which is the 411and C<AnyEvent> becomes ... C<$AnyEvent::Log::COLLECT> which is the
381exception of the rule - just like the parent of any package name in 412exception of the rule - just like the "parent" of any single-component
382Perl is C<main>, the default parent of any toplevel package context is 413package name in Perl is C<main>, the default slave of any top-level
383C<AnyEvent::Log::Top>. 414package context is C<$AnyEvent::Log::COLLECT>.
384 415
385Since perl packages form only an approximate hierarchy, this parent 416Since perl packages form only an approximate hierarchy, this slave
386context can of course be removed. 417context can of course be removed.
387 418
388All other (anonymous) contexts have no parents and an empty title by 419All other (anonymous) contexts have no slaves and an empty title by
389default. 420default.
390 421
391When the module is loaded it creates the default context called 422When the module is loaded it creates the C<$AnyEvent::Log::LOG> logging
392C<AnyEvent::Log::Default>, which simply logs everything to STDERR and 423context that simply logs everything via C<warn>, without propagating
393doesn't propagate anything anywhere by default. The purpose of the default 424anything anywhere by default. The purpose of this context is to provide
394context is to provide a convenient place to override the global logging 425a convenient place to override the global logging target or to attach
395target or to attach additional log targets. It's not meant for filtering. 426additional log targets. It's not meant for filtering.
396 427
397It then creates the root context called C<AnyEvent::Log::Root> and 428It then creates the C<$AnyEvent::Log::FILTER> context whose
398sets its log level set to all levels up to the one specified by 429purpose is to suppress all messages with priority higher
399C<$ENV{PERL_ANYEVENT_VERBOSE}>. It then attached the default logging 430than C<$ENV{PERL_ANYEVENT_VERBOSE}>. It then attached the
400context to it. The purpose of the root context is to simply provide 431C<$AnyEvent::Log::LOG> context to it. The purpose of the filter context
401filtering according to some global log level. 432is to simply provide filtering according to some global log level.
402 433
403Finally it creates the toplevel package context called 434Finally it creates the top-level package context C<$AnyEvent::Log::COLLECT>
404C<AnyEvent::Log::Top> and attached the root context but otherwise leaves 435and attaches the C<$AnyEvent::Log::FILTER> context to it, but otherwise
405it at default config. It's purpose is simply to collect all log messages 436leaves it at default config. Its purpose is simply to collect all log
406system-wide. 437messages system-wide.
407 438
408These three special contexts can also be referred to by the names 439The hierarchy is then:
409C<AE::Log::Default>, C<AE::Log::Root> and C<AE::Log::Top>.
410 440
441 any package, eventually -> $COLLECT -> $FILTER -> $LOG
442
411The effect of all this is that log messages, by default, wander up 443The effect of all this is that log messages, by default, wander up to the
412to the root context where log messages with lower priority then 444C<$AnyEvent::Log::COLLECT> context where all messages normally end up,
445from there to C<$AnyEvent::Log::FILTER> where log messages with lower
413C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered away and then to the 446priority then C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered out and then
414AnyEvent::Log::Default context to be logged to STDERR. 447to the C<$AnyEvent::Log::LOG> context to be passed to C<warn>.
415 448
416Splitting the top level context into three contexts makes it easy to set 449This makes it easy to set a global logging level (by modifying $FILTER),
417a global logging level (by modifying the root context), but still allow 450but still allow other contexts to send, for example, their debug and trace
418other contexts to log, for example, their debug and trace messages to the
419default target despite the global logging level, or to attach additional 451messages to the $LOG target despite the global logging level, or to attach
420log targets that log messages, regardless of the global logging level. 452additional log targets that log messages, regardless of the global logging
453level.
421 454
422It also makes it easy to replace the default STDERR-logger by something 455It also makes it easy to modify the default warn-logger ($LOG) to
423that logs to a file, or to attach additional logging targets. 456something that logs to a file, or to attach additional logging targets
457(such as loggign to a file) by attaching it to $FILTER.
424 458
425=head2 CREATING/FINDING/DESTROYING CONTEXTS 459=head2 CREATING/FINDING/DESTROYING CONTEXTS
426 460
427=over 4 461=over 4
428 462
450 : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx" 484 : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx"
451} 485}
452 486
453=item AnyEvent::Log::reset 487=item AnyEvent::Log::reset
454 488
455Deletes all contexts and recreates the default hierarchy, i.e. resets the 489Resets all package contexts and recreates the default hierarchy if
456logging subsystem to defaults. 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.
457 493
458This can be used to implement config-file (re-)loading: before loading a 494This can be used to implement config-file (re-)loading: before loading a
459configuration, reset all contexts. 495configuration, reset all contexts.
460 496
461=cut 497=cut
462 498
463sub reset { 499sub reset {
464 @$_ = () for values %CTX; # just to be sure - to kill circular logging dependencies 500 # hard to kill complex data structures
465 %CTX = (); 501 # we "recreate" all package loggers and reset the hierarchy
502 while (my ($k, $v) = each %CTX) {
503 @$v = ($k, (1 << 10) - 1 - 1, { });
466 504
467 my $default = ctx undef; 505 $v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log::COLLECT);
468 $default->title ("AnyEvent::Log::Default"); 506 }
507
508 @$_ = ($_->[0], (1 << 10) - 1 - 1)
509 for $LOG, $FILTER, $COLLECT;
510
511 $LOG->slaves;
512 $LOG->title ('$AnyEvent::Log::LOG');
469 $default->log_cb (sub { 513 $LOG->log_cb (sub {
470 print STDERR shift; 514 warn shift;
471 0 515 0
472 }); 516 });
473 $CTX{"AnyEvent::Log::Default"} = $CTX{"AE::Log::Default"} = $default;
474 517
475 my $root = ctx undef; 518 $FILTER->slaves ($LOG);
476 $root->title ("AnyEvent::Log::Root"); 519 $FILTER->title ('$AnyEvent::Log::FILTER');
477 $root->level ($AnyEvent::VERBOSE); 520 $FILTER->level ($AnyEvent::VERBOSE);
478 $root->attach ($default);
479 $CTX{"AnyEvent::Log::Root"} = $CTX{"AE::Log::Root"} = $root;
480 521
481 my $top = ctx undef; 522 $COLLECT->slaves ($FILTER);
482 $top->title ("AnyEvent::Log::Top"); 523 $COLLECT->title ('$AnyEvent::Log::COLLECT');
483 $top->attach ($root); 524
484 $CTX{"AnyEvent::Log::Top"} = $CTX{"AE::Log::Top"} = $top; 525 _reassess;
485} 526}
527
528# create the default logger contexts
529$LOG = ctx undef;
530$FILTER = ctx undef;
531$COLLECT = ctx undef;
486 532
487AnyEvent::Log::reset; 533AnyEvent::Log::reset;
488 534
535# hello, CPAN, please catch me
489package AnyEvent::Log::Default; 536package AnyEvent::Log::LOG;
490package AE::Log::Default; 537package AE::Log::LOG;
538package AnyEvent::Log::FILTER;
539package AE::Log::FILTER;
540package AnyEvent::Log::COLLECT;
541package AE::Log::COLLECT;
542
491package AnyEvent::Log::Root; 543package AnyEvent::Log::Ctx;
492package AE::Log::Root; 544
493package AnyEvent::Log::Top; 545# 0 1 2 3 4
494package AE::Log::Top; 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 ;
495 567
496=back 568=back
497 569
498=cut 570=cut
499 571
500package AnyEvent::Log::Ctx; 572sub new {
573 my $class = shift;
501 574
502# 0 1 2 3 4 575 my $ctx = AnyEvent::Log::ctx undef;
503# [$title, $level, %$parents, &$logcb, &$fmtcb] 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
504 585
505=head2 CONFIGURING A LOG CONTEXT 586=head2 CONFIGURING A LOG CONTEXT
506 587
507The following methods can be used to configure the logging context. 588The following methods can be used to configure the logging context.
508 589
602 AnyEvent::Log::_reassess; 683 AnyEvent::Log::_reassess;
603} 684}
604 685
605=back 686=back
606 687
607=head3 PARENT CONTEXTS 688=head3 SLAVE CONTEXTS
608 689
609The following methods attach and detach another logging context to a 690The following methods attach and detach another logging context to a
610logging context. 691logging context.
611 692
612Log messages are propagated to all parent contexts, unless the logging 693Log messages are propagated to all slave contexts, unless the logging
613callback consumes the message. 694callback consumes the message.
614 695
615=over 4 696=over 4
616 697
617=item $ctx->attach ($ctx2[, $ctx3...]) 698=item $ctx->attach ($ctx2[, $ctx3...])
618 699
619Attaches the given contexts as parents to this context. It is not an error 700Attaches the given contexts as slaves to this context. It is not an error
620to add a context twice (the second add will be ignored). 701to add a context twice (the second add will be ignored).
621 702
622A context can be specified either as package name or as a context object. 703A context can be specified either as package name or as a context object.
623 704
624=item $ctx->detach ($ctx2[, $ctx3...]) 705=item $ctx->detach ($ctx2[, $ctx3...])
625 706
626Removes the given parents from this context - it's not an error to attempt 707Removes the given slaves from this context - it's not an error to attempt
627to remove a context that hasn't been added. 708to remove a context that hasn't been added.
628 709
629A context can be specified either as package name or as a context object. 710A context can be specified either as package name or as a context object.
630 711
631=item $ctx->parents ($ctx2[, $ctx3...]) 712=item $ctx->slaves ($ctx2[, $ctx3...])
632 713
633Replaces all parents attached to this context by the ones given. 714Replaces all slaves attached to this context by the ones given.
634 715
635=cut 716=cut
636 717
637sub attach { 718sub attach {
638 my $ctx = shift; 719 my $ctx = shift;
646 727
647 delete $ctx->[2]{$_+0} 728 delete $ctx->[2]{$_+0}
648 for map { AnyEvent::Log::ctx $_ } @_; 729 for map { AnyEvent::Log::ctx $_ } @_;
649} 730}
650 731
651sub parents { 732sub slaves {
652 undef $_[0][2]; 733 undef $_[0][2];
653 &attach; 734 &attach;
654} 735}
655 736
656=back 737=back
657 738
658=head3 MESSAGE LOGGING 739=head3 LOG TARGETS
659 740
660The following methods configure how the logging context actually does 741The following methods configure how the logging context actually does
661the logging (which consists of formatting the message and printing it or 742the logging (which consists of formatting the message and printing it or
662whatever it wants to do with it) and also allows you to log messages 743whatever it wants to do with it).
663directly to a context, without going via your package context.
664 744
665=over 4 745=over 4
666 746
667=item $ctx->log_cb ($cb->($str)) 747=item $ctx->log_cb ($cb->($str)
668 748
669Replaces the logging callback on the context (C<undef> disables the 749Replaces the logging callback on the context (C<undef> disables the
670logging callback). 750logging callback).
671 751
672The logging callback is responsible for handling formatted log messages 752The logging callback is responsible for handling formatted log messages
673(see C<fmt_cb> below) - normally simple text strings that end with a 753(see C<fmt_cb> below) - normally simple text strings that end with a
674newline (and are possibly multiline themselves). 754newline (and are possibly multiline themselves).
675 755
676It also has to return true iff it has consumed the log message, and false 756It also has to return true iff it has consumed the log message, and false
677if it hasn't. Consuming a message means that it will not be sent to any 757if it hasn't. Consuming a message means that it will not be sent to any
678parent context. When in doubt, return C<0> from your logging callback. 758slave context. When in doubt, return C<0> from your logging callback.
679 759
680Example: a very simple logging callback, simply dump the message to STDOUT 760Example: a very simple logging callback, simply dump the message to STDOUT
681and do not consume it. 761and do not consume it.
682 762
683 $ctx->log_cb (sub { print STDERR shift; 0 }); 763 $ctx->log_cb (sub { print STDERR shift; 0 });
691your program. 771your program.
692 772
693 $ctx->levels ("debug", "trace"); 773 $ctx->levels ("debug", "trace");
694 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages 774 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
695 775
696=item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message)) 776=item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
697 777
698Replaces the formatting callback on the context (C<undef> restores the 778Replaces the formatting callback on the context (C<undef> restores the
699default formatter). 779default formatter).
700 780
701The callback is passed the (possibly fractional) timestamp, the original 781The callback is passed the (possibly fractional) timestamp, the original
702logging context, the (numeric) logging level and the raw message string and needs to 782logging context, the (numeric) logging level and the raw message string
703return a formatted log message. In most cases this will be a string, but 783and needs to return a formatted log message. In most cases this will be a
704it could just as well be an array reference that just stores the values. 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.
705 790
706Example: format just the raw message, with numeric log level in angle 791Example: format just the raw message, with numeric log level in angle
707brackets. 792brackets.
708 793
709 $ctx->fmt_cb (sub { 794 $ctx->fmt_cb (sub {
726 "$msg->[3]"; 811 "$msg->[3]";
727 812
728 0 813 0
729 }); 814 });
730 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
731=cut 836=cut
732 837
733sub log_cb { 838sub log_cb {
734 my ($ctx, $cb) = @_; 839 my ($ctx, $cb) = @_;
735 840
740 my ($ctx, $cb) = @_; 845 my ($ctx, $cb) = @_;
741 846
742 $ctx->[4] = $cb; 847 $ctx->[4] = $cb;
743} 848}
744 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
745=item $ctx->log ($level, $msg[, @params]) 905=item $ctx->log ($level, $msg[, @params])
746 906
747Same as C<AnyEvent::Log::log>, but uses the given context as log context. 907Same as C<AnyEvent::Log::log>, but uses the given context as log context.
748 908
749=item $logger = $ctx->logger ($level[, \$enabled]) 909=item $logger = $ctx->logger ($level[, \$enabled])
758 918
7591; 9191;
760 920
761=back 921=back
762 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.
973
974=back
975
763=head1 AUTHOR 976=head1 AUTHOR
764 977
765 Marc Lehmann <schmorp@schmorp.de> 978 Marc Lehmann <schmorp@schmorp.de>
766 http://home.schmorp.de/ 979 http://home.schmorp.de/
767 980

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines