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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines