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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines