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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines