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.10 by root, Fri Aug 19 21:17:08 2011 UTC vs.
Revision 1.36 by root, Thu Aug 25 05:39:47 2011 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines