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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines