ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent/Log.pm
(Generate patch)

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines