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.3 by root, Wed Aug 17 02:02:38 2011 UTC vs.
Revision 1.42 by root, Thu Sep 1 22:38:11 2011 UTC

2 2
3AnyEvent::Log - simple logging "framework" 3AnyEvent::Log - simple logging "framework"
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7Simple uses:
8
9 use AnyEvent;
10
11 AE::log debug => "hit my knee";
12 AE::log warn => "it's a bit too hot";
13 AE::log error => "the flag was false!";
14 AE::log fatal => "the bit toggled! run!"; # never returns
15
16 # available log levels in order:
17 # fatal alert critical error warn note info debug trace
18
19"Complex" uses (for speed sensitive code):
20
7 use AnyEvent::Log; 21 use AnyEvent::Log;
22
23 my $tracer = AnyEvent::Log::logger trace => \$my $trace;
24
25 $tracer->("i am here") if $trace;
26 $tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
27
28Configuration (also look at the EXAMPLES section):
29
30 # set logging for the current package to errors and higher only
31 AnyEvent::Log::ctx->level ("error");
32
33 # set logging level to suppress anything below "notice"
34 $AnyEvent::Log::FILTER->level ("notice");
35
36 # send all critical and higher priority messages to syslog,
37 # regardless of (most) other settings
38 $AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx
39 level => "critical",
40 log_to_syslog => "user",
41 );
8 42
9=head1 DESCRIPTION 43=head1 DESCRIPTION
10 44
11This module implements a relatively simple "logging framework". It doesn't 45This module implements a relatively simple "logging framework". It doesn't
12attempt to be "the" logging solution or even "a" logging solution for 46attempt to be "the" logging solution or even "a" logging solution for
13AnyEvent - AnyEvent simply creates logging messages internally, and this 47AnyEvent - AnyEvent simply creates logging messages internally, and this
14module more or less exposes the mechanism, with some extra spiff to allow 48module more or less exposes the mechanism, with some extra spiff to allow
15using it from other modules as well. 49using it from other modules as well.
16 50
17Remember that the default verbosity level is C<0>, so nothing 51Remember that the default verbosity level is C<0> (C<off>), so nothing
18will be logged, ever, unless you set C<$Anyvent::VERBOSE> or 52will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
19C<PERL_ANYEVENT_VERBOSE> to a higher number. 53before starting your program, or change the logging level at runtime with
54something like:
20 55
21Possible future extensions are to allow custom log targets (where the 56 use AnyEvent::Log;
22level is an object), log filtering based on package, formatting, aliasing 57 $AnyEvent::Log::FILTER->level ("info");
23or package groups.
24 58
59The design goal behind this module was to keep it simple (and small),
60but make it powerful enough to be potentially useful for any module, and
61extensive enough for the most common tasks, such as logging to multiple
62targets, or being able to log into a database.
63
64The module is also usable before AnyEvent itself is initialised, in which
65case some of the functionality might be reduced.
66
67The amount of documentation might indicate otherwise, but the runtime part
68of the module is still just below 300 lines of code.
69
70=head1 LOGGING LEVELS
71
72Logging levels in this module range from C<1> (highest priority) to C<9>
73(lowest priority). Note that the lowest numerical value is the highest
74priority, so when this document says "higher priority" it means "lower
75numerical value".
76
77Instead of specifying levels by name you can also specify them by aliases:
78
79 LVL NAME SYSLOG PERL NOTE
80 1 fatal emerg exit system unusable, aborts program!
81 2 alert failure in primary system
82 3 critical crit failure in backup system
83 4 error err die non-urgent program errors, a bug
84 5 warn warning possible problem, not necessarily error
85 6 note notice unusual conditions
86 7 info normal messages, no action required
87 8 debug debugging messages for development
88 9 trace copious tracing output
89
90As you can see, some logging levels have multiple aliases - the first one
91is the "official" name, the second one the "syslog" name (if it differs)
92and the third one the "perl" name, suggesting (only!) that you log C<die>
93messages at C<error> priority. The NOTE column tries to provide some
94rationale on how to chose a logging level.
95
96As a rough guideline, levels 1..3 are primarily meant for users of
97the program (admins, staff), and are the only logged to STDERR by
98default. Levels 4..6 are meant for users and developers alike, while
99levels 7..9 are usually meant for developers.
100
101You can normally only log a single message at highest priority level
102(C<1>, C<fatal>), because logging a fatal message will also quit the
103program - so use it sparingly :)
104
105Some methods also offer some extra levels, such as C<0>, C<off>, C<none>
106or C<all> - these are only valid in the methods they are documented for.
107
25=head1 LOG FUNCTIONS 108=head1 LOGGING FUNCTIONS
26 109
27These functions allow you to log messages. They always use the caller's 110These functions allow you to log messages. They always use the caller's
28package as a "logging module/source". Also, The main logging function is 111package 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> 112callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is
30module is loaded. 113loaded.
31 114
32=over 4 115=over 4
33 116
34=cut 117=cut
35 118
37 120
38use Carp (); 121use Carp ();
39use POSIX (); 122use POSIX ();
40 123
41use AnyEvent (); BEGIN { AnyEvent::common_sense } 124use AnyEvent (); BEGIN { AnyEvent::common_sense }
42use AnyEvent::Util (); 125#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log
126
127our $VERSION = $AnyEvent::VERSION;
128
129our ($COLLECT, $FILTER, $LOG);
43 130
44our ($now_int, $now_str1, $now_str2); 131our ($now_int, $now_str1, $now_str2);
45 132
46# Format Time, not public - yet? 133# Format Time, not public - yet?
47sub ft($) { 134sub ft($) {
52 if $now_int != $i; 139 if $now_int != $i;
53 140
54 "$now_str1$f$now_str2" 141 "$now_str1$f$now_str2"
55} 142}
56 143
57our %CFG; #TODO 144our %CTX; # all package contexts
145
146# creates a default package context object for the given package
147sub _pkg_ctx($) {
148 my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx";
149
150 # link "parent" package
151 my $parent = $_[0] =~ /^(.+)::/
152 ? $CTX{$1} ||= &_pkg_ctx ("$1")
153 : $COLLECT;
154
155 $ctx->[2]{$parent+0} = $parent;
156
157 $ctx
158}
58 159
59=item AnyEvent::Log::log $level, $msg[, @args] 160=item AnyEvent::Log::log $level, $msg[, @args]
60 161
61Requests logging of the given C<$msg> with the given log level (1..9). 162Requests logging of the given C<$msg> with the given log level, and
62You can also use the following strings as log level: C<fatal> (1), 163returns true if the message was logged I<somewhere>.
63C<alert> (2), C<critical> (3), C<error> (4), C<warn> (5), C<note> (6),
64C<info> (7), C<debug> (8), C<trace> (9).
65 164
66For C<fatal> log levels, the program will abort. 165For loglevel C<fatal>, the program will abort.
67 166
68If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the 167If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the
69C<$msg> is interpreted as an sprintf format string. 168C<$msg> is interpreted as an sprintf format string.
70 169
71The C<$msg> should not end with C<\n>, but may if that is convenient for 170The C<$msg> should not end with C<\n>, but may if that is convenient for
75supposed to return the message. It will be called only then the message 174supposed to return the message. It will be called only then the message
76actually gets logged, which is useful if it is costly to create the 175actually gets logged, which is useful if it is costly to create the
77message in the first place. 176message in the first place.
78 177
79Whether the given message will be logged depends on the maximum log level 178Whether the given message will be logged depends on the maximum log level
80and the caller's package. 179and the caller's package. The return value can be used to ensure that
180messages or not "lost" - for example, when L<AnyEvent::Debug> detects a
181runtime error it tries to log it at C<die> level, but if that message is
182lost it simply uses warn.
81 183
82Note that you can (and should) call this function as C<AnyEvent::log> or 184Note that you can (and should) call this function as C<AnyEvent::log> or
83C<AE::log>, without C<use>-ing this module if possible, as those functions 185C<AE::log>, without C<use>-ing this module if possible (i.e. you don't
84will laod the logging module on demand only. 186need any additional functionality), as those functions will load the
187logging module on demand only. They are also much shorter to write.
188
189Also, if you optionally generate a lot of debug messages (such as when
190tracing some code), you should look into using a logger callback and a
191boolean enabler (see C<logger>, below).
85 192
86Example: log something at error level. 193Example: log something at error level.
87 194
88 AE::log error => "something"; 195 AE::log error => "something";
89 196
97 204
98=cut 205=cut
99 206
100# also allow syslog equivalent names 207# also allow syslog equivalent names
101our %STR2LEVEL = ( 208our %STR2LEVEL = (
102 fatal => 1, emerg => 1, 209 fatal => 1, emerg => 1, exit => 1,
103 alert => 2, 210 alert => 2,
104 critical => 3, crit => 3, 211 critical => 3, crit => 3,
105 error => 4, err => 4, 212 error => 4, err => 4, die => 4,
106 warn => 5, warning => 5, 213 warn => 5, warning => 5,
107 note => 6, notice => 6, 214 note => 6, notice => 6,
108 info => 7, 215 info => 7,
109 debug => 8, 216 debug => 8,
110 trace => 9, 217 trace => 9,
111); 218);
112 219
220our $TIME_EXACT;
221
222sub exact_time($) {
223 $TIME_EXACT = shift;
224 *_ts = $AnyEvent::MODEL
225 ? $TIME_EXACT ? \&AE::now : \&AE::time
226 : sub () { $TIME_EXACT ? do { require Time::HiRes; Time::HiRes::time () } : time };
227}
228
229BEGIN {
230 exact_time 0;
231}
232
233AnyEvent::post_detect {
234 exact_time $TIME_EXACT;
235};
236
113our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace); 237our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
114 238
239# time, ctx, level, msg
240sub _format($$$$) {
241 my $ts = ft $_[0];
242 my $ct = " ";
243
244 my @res;
245
246 for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) {
247 push @res, "$ts$ct$_\n";
248 $ct = " + ";
249 }
250
251 join "", @res
252}
253
115sub _log { 254sub _log {
116 my ($pkg, $targ, $msg, @args) = @_; 255 my ($ctx, $level, $format, @args) = @_;
117 256
118 my $level = ref $targ ? die "Can't use reference as logging level (yet)" 257 $level = $level > 0 && $level <= 9
119 : $targ > 0 && $targ <= 9 ? $targ+0 258 ? $level+0
120 : $STR2LEVEL{$targ} || Carp::croak "$targ: not a valid logging level, caught"; 259 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
121 260
122 return if $level > $AnyEvent::VERBOSE; 261 my $mask = 1 << $level;
123 262
124 $msg = $msg->() if ref $msg; 263 my ($success, %seen, @ctx, $now, $fmt);
125 $msg = sprintf $msg, @args if @args;
126 $msg =~ s/\n$//;
127 264
128 # now we have a message, log it 265 do
129 #TODO: could do LOTS of stuff here, and should, at least in some later version 266 {
267 # skip if masked
268 if ($ctx->[1] & $mask && !$seen{$ctx+0}++) {
269 if ($ctx->[3]) {
270 # logging target found
130 271
131 $msg = sprintf "%5s %s: %s", $LEVEL2STR[$level], $pkg, $msg; 272 # now get raw message, unless we have it already
132 my $pfx = ft AE::now; 273 unless ($now) {
274 $format = $format->() if ref $format;
275 $format = sprintf $format, @args if @args;
276 $format =~ s/\n$//;
277 $now = _ts;
278 };
133 279
134 for (split /\n/, $msg) { 280 # format msg
135 printf STDERR "$pfx $_\n"; 281 my $str = $ctx->[4]
136 $pfx = "\t"; 282 ? $ctx->[4]($now, $_[0], $level, $format)
137 } 283 : ($fmt ||= _format $now, $_[0], $level, $format);
284
285 $success = 1;
286
287 $ctx->[3]($str)
288 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
289 } else {
290 push @ctx, values %{ $ctx->[2] }; # not masked - propagate
291 }
292 }
293 }
294 while $ctx = pop @ctx;
138 295
139 exit 1 if $level <= 1; 296 exit 1 if $level <= 1;
297
298 $success
140} 299}
141 300
142sub log($$;@) { 301sub log($$;@) {
143 _log +(caller)[0], @_; 302 _log
303 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
304 @_;
144} 305}
145 306
146*AnyEvent::log = *AE::log = \&log; 307*AnyEvent::log = *AE::log = \&log;
147 308
148=item $logger = AnyEvent::Log::logger $level[, \$enabled] 309=item $logger = AnyEvent::Log::logger $level[, \$enabled]
149 310
150Creates a code reference that, when called, acts as if the 311Creates a code reference that, when called, acts as if the
151C<AnyEvent::Log::log> function was called at this point with the givne 312C<AnyEvent::Log::log> function was called at this point with the given
152level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with 313level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
153the C<AnyEvent::Log::log> function: 314the C<AnyEvent::Log::log> function:
154 315
155 my $debug_log = AnyEvent::Log::logger "debug"; 316 my $debug_log = AnyEvent::Log::logger "debug";
156 317
181 # and later in your program 342 # and later in your program
182 $debug_log->("yo, stuff here") if $debug; 343 $debug_log->("yo, stuff here") if $debug;
183 344
184 $debug and $debug_log->("123"); 345 $debug and $debug_log->("123");
185 346
186Note: currently the enabled var is always true - that will be fixed in a
187future version :)
188
189=cut 347=cut
190 348
191our %LOGGER; 349our %LOGGER;
192 350
193# re-assess logging status for all loggers 351# re-assess logging status for all loggers
194sub _reassess { 352sub _reassess {
353 local $SIG{__DIE__};
354 my $die = sub { die };
355
195 for (@_ ? $LOGGER{$_[0]} : values %LOGGER) { 356 for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
196 my ($pkg, $level, $renabled) = @$_; 357 my ($ctx, $level, $renabled) = @$_;
197 358
198 # to detetc whether a message would be logged, we # actually 359 # to detect whether a message would be logged, we actually
199 # try to log one and die. this isn't # fast, but we can be 360 # try to log one and die. this isn't fast, but we can be
200 # sure that the logging decision is correct :) 361 # sure that the logging decision is correct :)
201 362
202 $$renabled = !eval { 363 $$renabled = !eval {
203 local $SIG{__DIE__};
204
205 _log $pkg, $level, sub { die }; 364 _log $ctx, $level, $die;
206 365
207 1 366 1
208 }; 367 };
209
210 $$renabled = 1; # TODO
211 } 368 }
212} 369}
213 370
214sub logger($;$) { 371sub _logger {
215 my ($level, $renabled) = @_; 372 my ($ctx, $level, $renabled) = @_;
216
217 $renabled ||= \my $enabled;
218 my $pkg = (caller)[0];
219 373
220 $$renabled = 1; 374 $$renabled = 1;
221 375
222 my $logger = [$pkg, $level, $renabled]; 376 my $logger = [$ctx, $level, $renabled];
223 377
224 $LOGGER{$logger+0} = $logger; 378 $LOGGER{$logger+0} = $logger;
225 379
226 _reassess $logger+0; 380 _reassess $logger+0;
227 381
382 require AnyEvent::Util;
228 my $guard = AnyEvent::Util::guard { 383 my $guard = AnyEvent::Util::guard (sub {
229 # "clean up" 384 # "clean up"
230 delete $LOGGER{$logger+0}; 385 delete $LOGGER{$logger+0};
231 }; 386 });
232 387
233 sub { 388 sub {
234 $guard if 0; # keep guard alive, but don't cause runtime overhead 389 $guard if 0; # keep guard alive, but don't cause runtime overhead
235 390
236 _log $pkg, $level, @_ 391 _log $ctx, $level, @_
237 if $$renabled; 392 if $$renabled;
238 } 393 }
239} 394}
240 395
241#TODO 396sub logger($;$) {
397 _logger
398 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
399 @_
400}
401
402=item AnyEvent::Log::exact_time $on
403
404By default, C<AnyEvent::Log> will use C<AE::now>, i.e. the cached
405eventloop time, for the log timestamps. After calling this function with a
406true value it will instead resort to C<AE::time>, i.e. fetch the current
407time on each log message. This only makes a difference for event loops
408that actually cache the time (such as L<EV> or L<AnyEvent::Loop>).
409
410This setting can be changed at any time by calling this function.
411
412Since C<AnyEvent::Log> has to work even before the L<AnyEvent> has been
413initialised, this switch will also decide whether to use C<CORE::time> or
414C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes
415available.
242 416
243=back 417=back
244 418
245=head1 CONFIGURATION FUNCTIONALITY 419=head1 LOGGING CONTEXTS
246 420
247None, yet, except for C<PERL_ANYEVENT_VERBOSE>, described in the L<AnyEvent> manpage. 421This module associates every log message with a so-called I<logging
422context>, based on the package of the caller. Every perl package has its
423own logging context.
424
425A logging context has three major responsibilities: filtering, logging and
426propagating the message.
427
428For the first purpose, filtering, each context has a set of logging
429levels, called the log level mask. Messages not in the set will be ignored
430by this context (masked).
431
432For logging, the context stores a formatting callback (which takes the
433timestamp, context, level and string message and formats it in the way
434it should be logged) and a logging callback (which is responsible for
435actually logging the formatted message and telling C<AnyEvent::Log>
436whether it has consumed the message, or whether it should be propagated).
437
438For propagation, a context can have any number of attached I<slave
439contexts>. Any message that is neither masked by the logging mask nor
440masked by the logging callback returning true will be passed to all slave
441contexts.
442
443Each call to a logging function will log the message at most once per
444context, so it does not matter (much) if there are cycles or if the
445message can arrive at the same context via multiple paths.
446
447=head2 DEFAULTS
448
449By default, all logging contexts have an full set of log levels ("all"), a
450disabled logging callback and the default formatting callback.
451
452Package contexts have the package name as logging title by default.
453
454They have exactly one slave - the context of the "parent" package. The
455parent package is simply defined to be the package name without the last
456component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>,
457and C<AnyEvent> becomes ... C<$AnyEvent::Log::COLLECT> which is the
458exception of the rule - just like the "parent" of any single-component
459package name in Perl is C<main>, the default slave of any top-level
460package context is C<$AnyEvent::Log::COLLECT>.
461
462Since perl packages form only an approximate hierarchy, this slave
463context can of course be removed.
464
465All other (anonymous) contexts have no slaves and an empty title by
466default.
467
468When the module is loaded it creates the C<$AnyEvent::Log::LOG> logging
469context that simply logs everything via C<warn>, without propagating
470anything anywhere by default. The purpose of this context is to provide
471a convenient place to override the global logging target or to attach
472additional log targets. It's not meant for filtering.
473
474It then creates the C<$AnyEvent::Log::FILTER> context whose
475purpose is to suppress all messages with priority higher
476than C<$ENV{PERL_ANYEVENT_VERBOSE}>. It then attached the
477C<$AnyEvent::Log::LOG> context to it. The purpose of the filter context
478is to simply provide filtering according to some global log level.
479
480Finally it creates the top-level package context C<$AnyEvent::Log::COLLECT>
481and attaches the C<$AnyEvent::Log::FILTER> context to it, but otherwise
482leaves it at default config. Its purpose is simply to collect all log
483messages system-wide.
484
485The hierarchy is then:
486
487 any package, eventually -> $COLLECT -> $FILTER -> $LOG
488
489The effect of all this is that log messages, by default, wander up to the
490C<$AnyEvent::Log::COLLECT> context where all messages normally end up,
491from there to C<$AnyEvent::Log::FILTER> where log messages with lower
492priority then C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered out and then
493to the C<$AnyEvent::Log::LOG> context to be passed to C<warn>.
494
495This makes it easy to set a global logging level (by modifying $FILTER),
496but still allow other contexts to send, for example, their debug and trace
497messages to the $LOG target despite the global logging level, or to attach
498additional log targets that log messages, regardless of the global logging
499level.
500
501It also makes it easy to modify the default warn-logger ($LOG) to
502something that logs to a file, or to attach additional logging targets
503(such as loggign to a file) by attaching it to $FILTER.
504
505=head2 CREATING/FINDING/DESTROYING CONTEXTS
248 506
249=over 4 507=over 4
250 508
509=item $ctx = AnyEvent::Log::ctx [$pkg]
510
511This function creates or returns a logging context (which is an object).
512
513If a package name is given, then the context for that packlage is
514returned. If it is called without any arguments, then the context for the
515callers package is returned (i.e. the same context as a C<AE::log> call
516would use).
517
518If C<undef> is given, then it creates a new anonymous context that is not
519tied to any package and is destroyed when no longer referenced.
520
251=cut 521=cut
522
523sub ctx(;$) {
524 my $pkg = @_ ? shift : (caller)[0];
525
526 ref $pkg
527 ? $pkg
528 : defined $pkg
529 ? $CTX{$pkg} ||= AnyEvent::Log::_pkg_ctx $pkg
530 : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx"
531}
532
533=item AnyEvent::Log::reset
534
535Resets all package contexts and recreates the default hierarchy if
536necessary, i.e. resets the logging subsystem to defaults, as much as
537possible. This process keeps references to contexts held by other parts of
538the program intact.
539
540This can be used to implement config-file (re-)loading: before loading a
541configuration, reset all contexts.
542
543=cut
544
545sub reset {
546 # hard to kill complex data structures
547 # we "recreate" all package loggers and reset the hierarchy
548 while (my ($k, $v) = each %CTX) {
549 @$v = ($k, (1 << 10) - 1 - 1, { });
550
551 $v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log::COLLECT);
552 }
553
554 @$_ = ($_->[0], (1 << 10) - 1 - 1)
555 for $LOG, $FILTER, $COLLECT;
556
557 #$LOG->slaves;
558 $LOG->title ('$AnyEvent::Log::LOG');
559 $LOG->log_to_warn;
560
561 $FILTER->slaves ($LOG);
562 $FILTER->title ('$AnyEvent::Log::FILTER');
563 $FILTER->level ($AnyEvent::VERBOSE);
564
565 $COLLECT->slaves ($FILTER);
566 $COLLECT->title ('$AnyEvent::Log::COLLECT');
567
568 _reassess;
569}
570
571# create the default logger contexts
572$LOG = ctx undef;
573$FILTER = ctx undef;
574$COLLECT = ctx undef;
575
576AnyEvent::Log::reset;
577
578# hello, CPAN, please catch me
579package AnyEvent::Log::LOG;
580package AE::Log::LOG;
581package AnyEvent::Log::FILTER;
582package AE::Log::FILTER;
583package AnyEvent::Log::COLLECT;
584package AE::Log::COLLECT;
585
586package AnyEvent::Log::Ctx;
587
588# 0 1 2 3 4
589# [$title, $level, %$slaves, &$logcb, &$fmtcb]
590
591=item $ctx = new AnyEvent::Log::Ctx methodname => param...
592
593This is a convenience constructor that makes it simpler to construct
594anonymous logging contexts.
595
596Each key-value pair results in an invocation of the method of the same
597name as the key with the value as parameter, unless the value is an
598arrayref, in which case it calls the method with the contents of the
599array. The methods are called in the same order as specified.
600
601Example: create a new logging context and set both the default logging
602level, some slave contexts and a logging callback.
603
604 $ctx = new AnyEvent::Log::Ctx
605 title => "dubious messages",
606 level => "error",
607 log_cb => sub { print STDOUT shift; 0 },
608 slaves => [$ctx1, $ctx, $ctx2],
609 ;
610
611=back
612
613=cut
614
615sub new {
616 my $class = shift;
617
618 my $ctx = AnyEvent::Log::ctx undef;
619
620 while (@_) {
621 my ($k, $v) = splice @_, 0, 2;
622 $ctx->$k (ref $v eq "ARRAY" ? @$v : $v);
623 }
624
625 bless $ctx, $class # do we really support subclassing, hmm?
626}
627
628
629=head2 CONFIGURING A LOG CONTEXT
630
631The following methods can be used to configure the logging context.
632
633=over 4
634
635=item $ctx->title ([$new_title])
636
637Returns the title of the logging context - this is the package name, for
638package contexts, and a user defined string for all others.
639
640If C<$new_title> is given, then it replaces the package name or title.
641
642=cut
643
644sub title {
645 $_[0][0] = $_[1] if @_ > 1;
646 $_[0][0]
647}
648
649=back
650
651=head3 LOGGING LEVELS
652
653The following methods deal with the logging level set associated with the
654log context.
655
656The most common method to use is probably C<< $ctx->level ($level) >>,
657which configures the specified and any higher priority levels.
658
659All functions which accept a list of levels also accept the special string
660C<all> which expands to all logging levels.
661
662=over 4
663
664=item $ctx->levels ($level[, $level...)
665
666Enables logging for the given levels and disables it for all others.
667
668=item $ctx->level ($level)
669
670Enables logging for the given level and all lower level (higher priority)
671ones. In addition to normal logging levels, specifying a level of C<0> or
672C<off> disables all logging for this level.
673
674Example: log warnings, errors and higher priority messages.
675
676 $ctx->level ("warn");
677 $ctx->level (5); # same thing, just numeric
678
679=item $ctx->enable ($level[, $level...])
680
681Enables logging for the given levels, leaving all others unchanged.
682
683=item $ctx->disable ($level[, $level...])
684
685Disables logging for the given levels, leaving all others unchanged.
686
687=cut
688
689sub _lvl_lst {
690 map {
691 $_ > 0 && $_ <= 9 ? $_+0
692 : $_ eq "all" ? (1 .. 9)
693 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
694 } @_
695}
696
697our $NOP_CB = sub { 0 };
698
699sub levels {
700 my $ctx = shift;
701 $ctx->[1] = 0;
702 $ctx->[1] |= 1 << $_
703 for &_lvl_lst;
704 AnyEvent::Log::_reassess;
705}
706
707sub level {
708 my $ctx = shift;
709 my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
710
711 $ctx->[1] = ((1 << $lvl) - 1) << 1;
712 AnyEvent::Log::_reassess;
713}
714
715sub enable {
716 my $ctx = shift;
717 $ctx->[1] |= 1 << $_
718 for &_lvl_lst;
719 AnyEvent::Log::_reassess;
720}
721
722sub disable {
723 my $ctx = shift;
724 $ctx->[1] &= ~(1 << $_)
725 for &_lvl_lst;
726 AnyEvent::Log::_reassess;
727}
728
729=back
730
731=head3 SLAVE CONTEXTS
732
733The following methods attach and detach another logging context to a
734logging context.
735
736Log messages are propagated to all slave contexts, unless the logging
737callback consumes the message.
738
739=over 4
740
741=item $ctx->attach ($ctx2[, $ctx3...])
742
743Attaches the given contexts as slaves to this context. It is not an error
744to add a context twice (the second add will be ignored).
745
746A context can be specified either as package name or as a context object.
747
748=item $ctx->detach ($ctx2[, $ctx3...])
749
750Removes the given slaves from this context - it's not an error to attempt
751to remove a context that hasn't been added.
752
753A context can be specified either as package name or as a context object.
754
755=item $ctx->slaves ($ctx2[, $ctx3...])
756
757Replaces all slaves attached to this context by the ones given.
758
759=cut
760
761sub attach {
762 my $ctx = shift;
763
764 $ctx->[2]{$_+0} = $_
765 for map { AnyEvent::Log::ctx $_ } @_;
766}
767
768sub detach {
769 my $ctx = shift;
770
771 delete $ctx->[2]{$_+0}
772 for map { AnyEvent::Log::ctx $_ } @_;
773}
774
775sub slaves {
776 undef $_[0][2];
777 &attach;
778}
779
780=back
781
782=head3 LOG TARGETS
783
784The following methods configure how the logging context actually does
785the logging (which consists of formatting the message and printing it or
786whatever it wants to do with it).
787
788=over 4
789
790=item $ctx->log_cb ($cb->($str)
791
792Replaces the logging callback on the context (C<undef> disables the
793logging callback).
794
795The logging callback is responsible for handling formatted log messages
796(see C<fmt_cb> below) - normally simple text strings that end with a
797newline (and are possibly multiline themselves).
798
799It also has to return true iff it has consumed the log message, and false
800if it hasn't. Consuming a message means that it will not be sent to any
801slave context. When in doubt, return C<0> from your logging callback.
802
803Example: a very simple logging callback, simply dump the message to STDOUT
804and do not consume it.
805
806 $ctx->log_cb (sub { print STDERR shift; 0 });
807
808You can filter messages by having a log callback that simply returns C<1>
809and does not do anything with the message, but this counts as "message
810being logged" and might not be very efficient.
811
812Example: propagate all messages except for log levels "debug" and
813"trace". The messages will still be generated, though, which can slow down
814your program.
815
816 $ctx->levels ("debug", "trace");
817 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
818
819=item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
820
821Replaces the formatting callback on the context (C<undef> restores the
822default formatter).
823
824The callback is passed the (possibly fractional) timestamp, the original
825logging context, the (numeric) logging level and the raw message string
826and needs to return a formatted log message. In most cases this will be a
827string, but it could just as well be an array reference that just stores
828the values.
829
830If, for some reason, you want to use C<caller> to find out more baout the
831logger then you should walk up the call stack until you are no longer
832inside the C<AnyEvent::Log> package.
833
834Example: format just the raw message, with numeric log level in angle
835brackets.
836
837 $ctx->fmt_cb (sub {
838 my ($time, $ctx, $lvl, $msg) = @_;
839
840 "<$lvl>$msg\n"
841 });
842
843Example: return an array reference with just the log values, and use
844C<PApp::SQL::sql_exec> to store the emssage in a database.
845
846 $ctx->fmt_cb (sub { \@_ });
847 $ctx->log_cb (sub {
848 my ($msg) = @_;
849
850 sql_exec "insert into log (when, subsys, prio, msg) values (?, ?, ?, ?)",
851 $msg->[0] + 0,
852 "$msg->[1]",
853 $msg->[2] + 0,
854 "$msg->[3]";
855
856 0
857 });
858
859=item $ctx->log_to_warn
860
861Sets the C<log_cb> to simply use C<CORE::warn> to report any messages
862(usually this logs to STDERR).
863
864=item $ctx->log_to_file ($path)
865
866Sets the C<log_cb> to log to a file (by appending), unbuffered.
867
868=item $ctx->log_to_path ($path)
869
870Same as C<< ->log_to_file >>, but opens the file for each message. This
871is much slower, but allows you to change/move/rename/delete the file at
872basically any time.
873
874Needless(?) to say, if you do not want to be bitten by some evil person
875calling C<chdir>, the path should be absolute. Doesn't help with
876C<chroot>, but hey...
877
878=item $ctx->log_to_syslog ([$facility])
879
880Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and
881all the others in the obvious way. If specified, then the C<$facility> is
882used as the facility (C<user>, C<auth>, C<local0> and so on). The default
883facility is C<user>.
884
885Note that this function also sets a C<fmt_cb> - the logging part requires
886an array reference with [$level, $str] as input.
887
888=cut
889
890sub log_cb {
891 my ($ctx, $cb) = @_;
892
893 $ctx->[3] = $cb;
894}
895
896sub fmt_cb {
897 my ($ctx, $cb) = @_;
898
899 $ctx->[4] = $cb;
900}
901
902sub log_to_warn {
903 my ($ctx, $path) = @_;
904
905 $ctx->log_cb (sub {
906 warn shift;
907 0
908 });
909}
910
911sub log_to_file {
912 my ($ctx, $path) = @_;
913
914 open my $fh, ">>", $path
915 or die "$path: $!";
916
917 $ctx->log_cb (sub {
918 syswrite $fh, shift;
919 0
920 });
921}
922
923sub log_to_path {
924 my ($ctx, $path) = @_;
925
926 $ctx->log_cb (sub {
927 open my $fh, ">>", $path
928 or die "$path: $!";
929
930 syswrite $fh, shift;
931 0
932 });
933}
934
935sub log_to_syslog {
936 my ($ctx, $facility) = @_;
937
938 require Sys::Syslog;
939
940 $ctx->fmt_cb (sub {
941 my $str = $_[3];
942 $str =~ s/\n(?=.)/\n+ /g;
943
944 [$_[2], "($_[1][0]) $str"]
945 });
946
947 $facility ||= "user";
948
949 $ctx->log_cb (sub {
950 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
951
952 Sys::Syslog::syslog ("$facility|" . ($lvl - 1), $_)
953 for split /\n/, $_[0][1];
954
955 0
956 });
957}
958
959=back
960
961=head3 MESSAGE LOGGING
962
963These methods allow you to log messages directly to a context, without
964going via your package context.
965
966=over 4
967
968=item $ctx->log ($level, $msg[, @params])
969
970Same as C<AnyEvent::Log::log>, but uses the given context as log context.
971
972=item $logger = $ctx->logger ($level[, \$enabled])
973
974Same as C<AnyEvent::Log::logger>, but uses the given context as log
975context.
976
977=cut
978
979*log = \&AnyEvent::Log::_log;
980*logger = \&AnyEvent::Log::_logger;
981
982=back
983
984=cut
985
986package AnyEvent::Log;
987
988=head1 CONFIGURATION VIA $ENV{PERL_ANYEVENT_LOG}
989
990Logging can also be configured by setting the environment variable
991C<PERL_ANYEVENT_LOG> (or C<AE_LOG>).
992
993The value consists of one or more logging context specifications separated
994by C<:> or whitespace. Each logging specification in turn starts with a
995context name, followed by C<=>, followed by zero or more comma-separated
996configuration directives, here are some examples:
997
998 # set default logging level
999 filter=warn
1000
1001 # log to file instead of to stderr
1002 log=file=/tmp/mylog
1003
1004 # log to file in addition to stderr
1005 log=+%file:%file=file=/tmp/mylog
1006
1007 # enable debug log messages, log warnings and above to syslog
1008 filter=debug:log=+%warnings:%warnings=warn,syslog=LOG_LOCAL0
1009
1010 # log trace messages (only) from AnyEvent::Debug to file
1011 AnyEvent::Debug=+%trace:%trace=only,trace,file=/tmp/tracelog
1012
1013A context name in the log specification can be any of the following:
1014
1015=over 4
1016
1017=item C<collect>, C<filter>, C<log>
1018
1019Correspond to the three predefined C<$AnyEvent::Log::COLLECT>,
1020C<AnyEvent::Log::FILTER> and C<$AnyEvent::Log::LOG> contexts.
1021
1022=item C<%name>
1023
1024Context names starting with a C<%> are anonymous contexts created when the
1025name is first mentioned. The difference to package contexts is that by
1026default they have no attached slaves.
1027
1028=item a perl package name
1029
1030Any other string references the logging context associated with the given
1031Perl C<package>. In the unlikely case where you want to specify a package
1032context that matches on of the other context name forms, you can add a
1033C<::> to the package name to force interpretation as a package.
1034
1035=back
1036
1037The configuration specifications can be any number of the following:
1038
1039=over 4
1040
1041=item C<stderr>
1042
1043Configures the context to use Perl's C<warn> function (which typically
1044logs to C<STDERR>). Works like C<log_to_warn>.
1045
1046=item C<file=>I<path>
1047
1048Configures the context to log to a file with the given path. Works like
1049C<log_to_file>.
1050
1051=item C<path=>I<path>
1052
1053Configures the context to log to a file with the given path. Works like
1054C<log_to_path>.
1055
1056=item C<syslog> or C<syslog=>I<expr>
1057
1058Configures the context to log to syslog. If I<expr> is given, then it is
1059evaluated in the L<Sys::Syslog> package, so you could use:
1060
1061 log=syslog=LOG_LOCAL0
1062
1063=item C<nolog>
1064
1065Configures the context to not log anything by itself, which is the
1066default. Same as C<< $ctx->log_cb (undef) >>.
1067
1068=item C<0> or C<off>
1069
1070Sets the logging level of the context ot C<0>, i.e. all messages will be
1071filtered out.
1072
1073=item C<all>
1074
1075Enables all logging levels, i.e. filtering will effectively be switched
1076off (the default).
1077
1078=item C<only>
1079
1080Disables all logging levels, and changes the interpretation of following
1081level specifications to enable the specified level only.
1082
1083Example: only enable debug messages for a context.
1084
1085 context=only,debug
1086
1087=item C<except>
1088
1089Enables all logging levels, and changes the interpretation of following
1090level specifications to disable that level. Rarely used.
1091
1092Example: enable all logging levels except fatal and trace (this is rather
1093nonsensical).
1094
1095 filter=exept,fatal,trace
1096
1097=item C<level>
1098
1099Enables all logging levels, and changes the interpretation of following
1100level specifications to be "that level or any higher priority
1101message". This is the default.
1102
1103Example: log anything at or above warn level.
1104
1105 filter=warn
1106
1107 # or, more verbose
1108 filter=only,level,warn
1109
1110=item C<1>..C<9> or a logging level name (C<error>, C<debug> etc.)
1111
1112A numeric loglevel or the name of a loglevel will be interpreted according
1113to the most recent C<only>, C<except> or C<level> directive. By default,
1114specifying a logging level enables that and any higher priority messages.
1115
1116=item C<+>I<context>
1117
1118Attaches the named context as slave to the context.
1119
1120=item C<+>
1121
1122A line C<+> detaches all contexts, i.e. clears the slave list from the
1123context. Anonymous (C<%name>) contexts have no attached slaves by default,
1124but package contexts have the parent context as slave by default.
1125
1126Example: log messages from My::Module to a file, do not send them to the
1127default log collector.
1128
1129 My::Module=+,file=/tmp/mymodulelog
1130
1131=back
1132
1133Any character can be escaped by prefixing it with a C<\> (backslash), as
1134usual, so to log to a file containing a comma, colon, backslash and some
1135spaces in the filename, you would do this:
1136
1137 PERL_ANYEVENT_LOG='log=file=/some\ \:file\ with\,\ \\-escapes'
1138
1139Since whitespace (which includes newlines) is allowed, it is fine to
1140specify multiple lines in C<PERL_ANYEVENT_LOG>, e.g.:
1141
1142 PERL_ANYEVENT_LOG="
1143 filter=warn
1144 AnyEvent::Debug=+%trace
1145 %trace=only,trace,+log
1146 " myprog
1147
1148Also, in the unlikely case when you want to concatenate specifications,
1149use whitespace as separator, as C<::> will be interpreted as part of a
1150module name, an empty spec with two separators:
1151
1152 PERL_ANYEVENT_LOG="$PERL_ANYEVENT_LOG MyMod=debug"
1153
1154=cut
1155
1156for (my $spec = $ENV{PERL_ANYEVENT_LOG}) {
1157 my %anon;
1158
1159 my $pkg = sub {
1160 $_[0] eq "log" ? $LOG
1161 : $_[0] eq "filter" ? $FILTER
1162 : $_[0] eq "collect" ? $COLLECT
1163 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= ctx undef)
1164 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/
1165 : die # never reached?
1166 };
1167
1168 /\G[[:space:]]+/gc; # skip initial whitespace
1169
1170 while (/\G((?:[^:=[:space:]]+|::|\\.)+)=/gc) {
1171 my $ctx = $pkg->($1);
1172 my $level = "level";
1173
1174 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
1175 for ("$1") {
1176 if ($_ eq "stderr" ) { $ctx->log_to_warn;
1177 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1");
1178 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1");
1179 } elsif (/syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ($1);
1180 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef);
1181 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1"));
1182 } elsif ($_ eq "+" ) { $ctx->slaves;
1183 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
1184 } elsif ($_ eq "all" ) { $ctx->level ("all");
1185 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level";
1186 } elsif ($_ eq "only" ) { $ctx->level ("off"); $level = "enable";
1187 } elsif ($_ eq "except" ) { $ctx->level ("all"); $level = "disable";
1188 } elsif (/^\d$/ ) { $ctx->$level ($_);
1189 } elsif (exists $STR2LEVEL{$_} ) { $ctx->$level ($_);
1190 } else { die "PERL_ANYEVENT_LOG ($spec): parse error at '$_'\n";
1191 }
1192 }
1193
1194 /\G,/gc or last;
1195 }
1196
1197 /\G[:[:space:]]+/gc or last;
1198 }
1199
1200 /\G[[:space:]]+/gc; # skip trailing whitespace
1201
1202 if (/\G(.+)/g) {
1203 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n";
1204 }
1205}
252 1206
2531; 12071;
1208
1209=head1 EXAMPLES
1210
1211This section shows some common configurations, both as code, and as
1212C<PERL_ANYEVENT_LOG> string.
1213
1214=over 4
1215
1216=item Setting the global logging level.
1217
1218Either put C<PERL_ANYEVENT_VERBOSE=><number> into your environment before
1219running your program, use C<PERL_ANYEVENT_LOG> or modify the log level of
1220the root context at runtime:
1221
1222 PERL_ANYEVENT_VERBOSE=5 ./myprog
1223
1224 PERL_ANYEVENT_LOG=log=warn
1225
1226 $AnyEvent::Log::FILTER->level ("warn");
1227
1228=item Append all messages to a file instead of sending them to STDERR.
1229
1230This is affected by the global logging level.
1231
1232 $AnyEvent::Log::LOG->log_to_file ($path);
1233
1234 PERL_ANYEVENT_LOG=log=file=/some/path
1235
1236=item Write all messages with priority C<error> and higher to a file.
1237
1238This writes them only when the global logging level allows it, because
1239it is attached to the default context which is invoked I<after> global
1240filtering.
1241
1242 $AnyEvent::Log::FILTER->attach
1243 new AnyEvent::Log::Ctx log_to_file => $path);
1244
1245 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
1246
1247This writes them regardless of the global logging level, because it is
1248attached to the toplevel context, which receives all messages I<before>
1249the global filtering.
1250
1251 $AnyEvent::Log::COLLECT->attach (
1252 new AnyEvent::Log::Ctx log_to_file => $path);
1253
1254 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
1255
1256In both cases, messages are still written to STDERR.
1257
1258=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
1259
1260Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
1261context - this simply circumvents the global filtering for trace messages.
1262
1263 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
1264 $debug->attach ($AnyEvent::Log::LOG);
1265
1266 PERL_ANYEVENT_LOG=AnyEvent::Debug=+log
1267
1268This of course works for any package, not just L<AnyEvent::Debug>, but
1269assumes the log level for AnyEvent::Debug hasn't been changed from the
1270default.
254 1271
255=back 1272=back
256 1273
257=head1 AUTHOR 1274=head1 AUTHOR
258 1275
259 Marc Lehmann <schmorp@schmorp.de> 1276 Marc Lehmann <schmorp@schmorp.de>
260 http://home.schmorp.de/ 1277 http://home.schmorp.de/
261 1278
262=cut 1279=cut
1280

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines