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

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents):
Revision 1.10 by root, Fri Aug 19 21:17:08 2011 UTC vs.
Revision 1.16 by root, Sat Aug 20 02:19:18 2011 UTC

20 $tracer->("i am here") if $trace; 20 $tracer->("i am here") if $trace;
21 $tracer->(sub { "lots of data: " . Dumper $self }) if $trace; 21 $tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
22 22
23 # configuration 23 # configuration
24 24
25 # set logging for this package to maximum 25 # set logging for this package to errors and higher only
26 AnyEvent::Log::ctx->level ("all"); 26 AnyEvent::Log::ctx->level ("error");
27 27
28 # set logging globally to anything below debug 28 # set logging globally to anything below debug
29 (AnyEvent::Log::ctx "")->level ("notice"); 29 $AnyEvent::Log::Root->level ("notice");
30 30
31 # see also EXAMPLES, below 31 # see also EXAMPLES, below
32
33 # disable logging for package "AnyEvent" and all packages below it
34 AnyEvent->AnyEvent::Log::ctx->level (0);
35
36 # log everything below debug to a file, for the whole program
37 my $ctx = AnyEvent::Log::ctx;
38 $ctx->log_cb (sub { print FILE shift; 0 });
39 (AnyEvent::Log::ctx "")->add ($ctx);
40 32
41=head1 DESCRIPTION 33=head1 DESCRIPTION
42 34
43This module implements a relatively simple "logging framework". It doesn't 35This module implements a relatively simple "logging framework". It doesn't
44attempt to be "the" logging solution or even "a" logging solution for 36attempt to be "the" logging solution or even "a" logging solution for
45AnyEvent - AnyEvent simply creates logging messages internally, and this 37AnyEvent - AnyEvent simply creates logging messages internally, and this
46module more or less exposes the mechanism, with some extra spiff to allow 38module more or less exposes the mechanism, with some extra spiff to allow
47using it from other modules as well. 39using it from other modules as well.
48 40
49Remember that the default verbosity level is C<0>, so nothing will be 41Remember that the default verbosity level is C<0>, so nothing will be
50logged, ever, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number 42logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number before
51before starting your program, or change the logging level at runtime wiht 43starting your program, or change the logging level at runtime with
52something like: 44something like:
53 45
54 use AnyEvent; 46 use AnyEvent;
55 (AnyEvent::Log::ctx "")->level ("info"); 47 (AnyEvent::Log::ctx "")->level ("info");
56 48
57The design goal behind this module was to keep it simple (and small), 49The design goal behind this module was to keep it simple (and small),
58but make it powerful enough to be potentially useful for any module, and 50but make it powerful enough to be potentially useful for any module, and
59extensive enough for the most common tasks, such as logging to multiple 51extensive enough for the most common tasks, such as logging to multiple
60targets, or being able to log into a database. 52targets, or being able to log into a database.
61 53
54The amount of documentation might indicate otherwise, but the module is
55still just 240 lines or so.
56
62=head1 LOGGING FUNCTIONS 57=head1 LOGGING FUNCTIONS
63 58
64These functions allow you to log messages. They always use the caller's 59These functions allow you to log messages. They always use the caller's
65package as a "logging module/source". Also, the main logging function is 60package as a "logging module/source". Also, the main logging function is
66callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is 61callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is
76use POSIX (); 71use POSIX ();
77 72
78use AnyEvent (); BEGIN { AnyEvent::common_sense } 73use AnyEvent (); BEGIN { AnyEvent::common_sense }
79use AnyEvent::Util (); 74use AnyEvent::Util ();
80 75
76our $VERSION = $AnyEvent::VERSION;
77
81our ($now_int, $now_str1, $now_str2); 78our ($now_int, $now_str1, $now_str2);
82 79
83# Format Time, not public - yet? 80# Format Time, not public - yet?
84sub ft($) { 81sub ft($) {
85 my $i = int $_[0]; 82 my $i = int $_[0];
96# creates a default package context object for the given package 93# creates a default package context object for the given package
97sub _pkg_ctx($) { 94sub _pkg_ctx($) {
98 my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx"; 95 my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx";
99 96
100 # link "parent" package 97 # link "parent" package
101 my $pkg = $_[0] =~ /^(.+)::/ ? $1 : ""; 98 my $pkg = $_[0] =~ /^(.+)::/ ? $1 : "AE::Log::Top";
102 99
103 $pkg = $CTX{$pkg} ||= &_pkg_ctx ($pkg); 100 $pkg = $CTX{$pkg} ||= &_pkg_ctx ($pkg);
104 $ctx->[2]{$pkg+0} = $pkg; 101 $ctx->[2]{$pkg+0} = $pkg;
105 102
106 $ctx 103 $ctx
132Note that you can (and should) call this function as C<AnyEvent::log> or 129Note that you can (and should) call this function as C<AnyEvent::log> or
133C<AE::log>, without C<use>-ing this module if possible (i.e. you don't 130C<AE::log>, without C<use>-ing this module if possible (i.e. you don't
134need any additional functionality), as those functions will load the 131need any additional functionality), as those functions will load the
135logging module on demand only. They are also much shorter to write. 132logging module on demand only. They are also much shorter to write.
136 133
137Also, if you otpionally generate a lot of debug messages (such as when 134Also, if you optionally generate a lot of debug messages (such as when
138tracing some code), you should look into using a logger callback and a 135tracing some code), you should look into using a logger callback and a
139boolean enabler (see C<logger>, below). 136boolean enabler (see C<logger>, below).
140 137
141Example: log something at error level. 138Example: log something at error level.
142 139
173 170
174our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace); 171our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
175 172
176# time, ctx, level, msg 173# time, ctx, level, msg
177sub _format($$$$) { 174sub _format($$$$) {
178 my $pfx = ft $_[0]; 175 my $ts = ft $_[0];
176 my $ct = " ";
177
179 my @res; 178 my @res;
180 179
181 for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) { 180 for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) {
182 push @res, "$pfx $_\n"; 181 push @res, "$ts$ct$_\n";
183 $pfx = "\t"; 182 $ct = " + ";
184 } 183 }
185 184
186 join "", @res 185 join "", @res
187} 186}
188 187
189sub _log { 188sub _log {
190 my ($ctx, $level, $format, @args) = @_; 189 my ($ctx, $level, $format, @args) = @_;
191 190
191 $level = $level > 0 && $level <= 9
192 ? $level+0
192 $level = $level > 0 && $level <= 9 ? $level+0 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; 193 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
193 194
194 my $mask = 1 << $level; 195 my $mask = 1 << $level;
195 196
196 my (@ctx, $now, $fmt); 197 my (%seen, @ctx, $now, $fmt);
197 198
198 do { 199 do
200 {
199 # skip if masked 201 # skip if masked
200 next unless $ctx->[1] & $mask; 202 if ($ctx->[1] & $mask && !$seen{$ctx+0}++) {
201
202 if ($ctx->[3]) { 203 if ($ctx->[3]) {
203 # logging target found 204 # logging target found
204 205
205 # now get raw message, unless we have it already 206 # now get raw message, unless we have it already
206 unless ($now) { 207 unless ($now) {
207 $format = $format->() if ref $format; 208 $format = $format->() if ref $format;
208 $format = sprintf $format, @args if @args; 209 $format = sprintf $format, @args if @args;
209 $format =~ s/\n$//; 210 $format =~ s/\n$//;
210 $now = AE::now; 211 $now = AE::now;
211 }; 212 };
212 213
213 # format msg 214 # format msg
214 my $str = $ctx->[4] 215 my $str = $ctx->[4]
215 ? $ctx->[4]($now, $_[0], $level, $format) 216 ? $ctx->[4]($now, $_[0], $level, $format)
216 : $fmt ||= _format $now, $_[0], $level, $format; 217 : $fmt ||= _format $now, $_[0], $level, $format;
217 218
218 $ctx->[3]($str) 219 $ctx->[3]($str);
219 and next; 220 }
221
222 # not masked, not consumed - propagate to parent contexts
223 push @ctx, values %{ $ctx->[2] };
224 }
220 } 225 }
221
222 # not masked, not consume - propagate to parent contexts
223 push @ctx, values %{ $ctx->[2] };
224 } while $ctx = pop @ctx; 226 while $ctx = pop @ctx;
225 227
226 exit 1 if $level <= 1; 228 exit 1 if $level <= 1;
227} 229}
228 230
229sub log($$;@) { 231sub log($$;@) {
270 # and later in your program 272 # and later in your program
271 $debug_log->("yo, stuff here") if $debug; 273 $debug_log->("yo, stuff here") if $debug;
272 274
273 $debug and $debug_log->("123"); 275 $debug and $debug_log->("123");
274 276
275Note: currently the enabled var is always true - that will be fixed in a
276future version :)
277
278=cut 277=cut
279 278
280our %LOGGER; 279our %LOGGER;
281 280
282# re-assess logging status for all loggers 281# re-assess logging status for all loggers
283sub _reassess { 282sub _reassess {
284 for (@_ ? $LOGGER{$_[0]} : values %LOGGER) { 283 for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
285 my ($ctx, $level, $renabled) = @$_; 284 my ($ctx, $level, $renabled) = @$_;
286 285
287 # to detetc whether a message would be logged, we # actually 286 # to detect whether a message would be logged, we # actually
288 # try to log one and die. this isn't # fast, but we can be 287 # try to log one and die. this isn't fast, but we can be
289 # sure that the logging decision is correct :) 288 # sure that the logging decision is correct :)
290 289
291 $$renabled = !eval { 290 $$renabled = !eval {
292 local $SIG{__DIE__}; 291 local $SIG{__DIE__};
293 292
298 297
299 $$renabled = 1; # TODO 298 $$renabled = 1; # TODO
300 } 299 }
301} 300}
302 301
303sub _logger($;$) { 302sub _logger {
304 my ($ctx, $level, $renabled) = @_; 303 my ($ctx, $level, $renabled) = @_;
305
306 $renabled ||= \my $enabled;
307 304
308 $$renabled = 1; 305 $$renabled = 1;
309 306
310 my $logger = [$ctx, $level, $renabled]; 307 my $logger = [$ctx, $level, $renabled];
311 308
356For propagation, a context can have any number of attached I<parent 353For propagation, a context can have any number of attached I<parent
357contexts>. Any message that is neither masked by the logging mask nor 354contexts>. Any message that is neither masked by the logging mask nor
358masked by the logging callback returning true will be passed to all parent 355masked by the logging callback returning true will be passed to all parent
359contexts. 356contexts.
360 357
358Each call to a logging function will log the message at most once per
359context, so it does not matter (much) if there are cycles or if the
360message can arrive at the same context via multiple paths.
361
361=head2 DEFAULTS 362=head2 DEFAULTS
362 363
363By default, all logging contexts have an full set of log levels ("all"), a 364By default, all logging contexts have an full set of log levels ("all"), a
364disabled logging callback and the default formatting callback. 365disabled logging callback and the default formatting callback.
365 366
366Package contexts have the package name as logging title by default. 367Package contexts have the package name as logging title by default.
367 368
368They have exactly one parent - the context of the "parent" package. The 369They have exactly one parent - the context of the "parent" package. The
369parent package is simply defined to be the package name without the last 370parent package is simply defined to be the package name without the last
370component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>, 371component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>,
371and C<AnyEvent> becomes the empty string. 372and C<AnyEvent> becomes ... C<AnyEvent::Log::Top> which is the
373exception of the rule - just like the parent of any package name in
374Perl is C<main>, the default parent of any top-level package context is
375C<AnyEvent::Log::Top>.
372 376
373Since perl packages form only an approximate hierarchy, this parent 377Since perl packages form only an approximate hierarchy, this parent
374context can of course be removed. 378context can of course be removed.
375 379
376All other (anonymous) contexts have no parents and an empty title by 380All other (anonymous) contexts have no parents and an empty title by
377default. 381default.
378 382
379When the module is first loaded, it configures the root context (the one 383When the module is loaded it creates the default context called
380with the empty string) to simply dump all log messages to C<STDERR>, 384C<AnyEvent::Log::Default> (also stored in C<$AnyEvent::Log::Default>),
381and sets it's log level set to all levels up to the one specified by 385which simply logs everything via C<warn> and doesn't propagate anything
382C<$ENV{PERL_ANYEVENT_VERBOSE}>. 386anywhere by default. The purpose of the default context is to provide
387a convenient place to override the global logging target or to attach
388additional log targets. It's not meant for filtering.
383 389
390It then creates the root context called C<AnyEvent::Log::Root> (also
391stored in C<$AnyEvent::Log::Root>) and sets its log level set to all
392levels up to the one specified by C<$ENV{PERL_ANYEVENT_VERBOSE}>. It
393then attached the default logging context to it. The purpose of the root
394context is to simply provide filtering according to some global log level.
395
396Finally it creates the top-level package context called
397C<AnyEvent::Log::Top> (also stored in, you might have guessed,
398C<$AnyEvent::Log::Top>) and attached the root context but otherwise leaves
399it at default config. It's purpose is simply to collect all log messages
400system-wide.
401
402These three special contexts can also be referred to by the
403package/context names C<AE::Log::Default>, C<AE::Log::Root> and
404C<AE::Log::Top>.
405
384The effect of all this is that log messages, by default, wander up to the 406The effect of all this is that log messages, by default, wander up
385root context and will be logged to STDERR if their log level is less than 407to the root context where log messages with lower priority then
386or equal to C<$ENV{PERL_ANYEVENT_VERBOSE}>. 408C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered away and then to the
409AnyEvent::Log::Default context to be passed to C<warn>.
387 410
411Splitting the top level context into three contexts makes it easy to set
412a global logging level (by modifying the root context), but still allow
413other contexts to log, for example, their debug and trace messages to the
414default target despite the global logging level, or to attach additional
415log targets that log messages, regardless of the global logging level.
416
417It also makes it easy to replace the default warn-logger by something that
418logs to a file, or to attach additional logging targets.
419
388=head2 CREATING/FINDING A CONTEXT 420=head2 CREATING/FINDING/DESTROYING CONTEXTS
389 421
390=over 4 422=over 4
391 423
392=item $ctx = AnyEvent::Log::ctx [$pkg] 424=item $ctx = AnyEvent::Log::ctx [$pkg]
393 425
411 : defined $pkg 443 : defined $pkg
412 ? $CTX{$pkg} ||= AnyEvent::Log::_pkg_ctx $pkg 444 ? $CTX{$pkg} ||= AnyEvent::Log::_pkg_ctx $pkg
413 : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx" 445 : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx"
414} 446}
415 447
416# create default root context 448=item AnyEvent::Log::reset
417{ 449
418 my $root = ctx undef; 450Resets all package contexts and recreates the default hierarchy if
419 $root->[0] = ""; 451necessary, i.e. resets the logging subsystem to defaults, as much as
420 $root->title ("default"); 452possible. This process keeps references to contexts held by other parts of
421 $root->level ($AnyEvent::VERBOSE); undef $AnyEvent::VERBOSE; 453the program intact.
422 $root->log_cb (sub { 454
423 print STDERR shift; 455This can be used to implement config-file (re-)loading: before loading a
456configuration, reset all contexts.
457
458=cut
459
460sub reset {
461 # hard to kill complex data structures
462 # we recreate all package loggers and reset the hierarchy
463 while (my ($k, $v) = each %CTX) {
464 @$v = ($k, (1 << 10) - 1 - 1, { });
465
466 my $pkg = $k =~ /^(.+)::/ ? $1 : "AE::Log::Top";
467 $v->attach ($CTX{$pkg});
468 }
469
470 $AnyEvent::Log::Default->parents;
471 $AnyEvent::Log::Default->title ("AnyEvent::Log::Default");
472 $AnyEvent::Log::Default->log_cb (sub {
473 warn shift;
424 0 474 0
425 }); 475 });
426 $CTX{""} = $root; 476 $CTX{"AnyEvent::Log::Default"} = $CTX{"AE::Log::Default"} = $AnyEvent::Log::Default;
427}
428 477
429=back 478 $AnyEvent::Log::Root->parents ($AnyEvent::Log::Default);
479 $AnyEvent::Log::Root->title ("AnyEvent::Log::Root");
480 $AnyEvent::Log::Root->level ($AnyEvent::VERBOSE);
481 $CTX{"AnyEvent::Log::Root"} = $CTX{"AE::Log::Root"} = $AnyEvent::Log::Root;
430 482
431=cut 483 $AnyEvent::Log::Top->parents ($AnyEvent::Log::Root);
484 $AnyEvent::Log::Top->title ("AnyEvent::Log::Top");
485 $CTX{"AnyEvent::Log::Top"} = $CTX{"AE::Log::Top"} = $AnyEvent::Log::Top;
486
487 _reassess;
488}
489
490# create the default logger contexts
491$AnyEvent::Log::Default = ctx undef;
492$AnyEvent::Log::Root = ctx undef;
493$AnyEvent::Log::Top = ctx undef;
494
495AnyEvent::Log::reset;
496
497# hello, CPAN, please catch me
498package AnyEvent::Log::Default;
499package AE::Log::Default;
500package AnyEvent::Log::Root;
501package AE::Log::Root;
502package AnyEvent::Log::Top;
503package AE::Log::Top;
432 504
433package AnyEvent::Log::Ctx; 505package AnyEvent::Log::Ctx;
434 506
435# 0 1 2 3 4 507# 0 1 2 3 4
436# [$title, $level, %$parents, &$logcb, &$fmtcb] 508# [$title, $level, %$parents, &$logcb, &$fmtcb]
509
510=item $ctx = new AnyEvent::Log::Ctx methodname => param...
511
512This is a convenience constructor that makes it simpler to construct
513anonymous logging contexts.
514
515Each key-value pair results in an invocation of the method of the same
516name as the key with the value as parameter, unless the value is an
517arrayref, in which case it calls the method with the contents of the
518array. The methods are called in the same order as specified.
519
520Example: create a new logging context and set both the default logging
521level, some parent contexts and a logging callback.
522
523 $ctx = new AnyEvent::Log::Ctx
524 title => "dubious messages",
525 level => "error",
526 log_cb => sub { print STDOUT shift; 0 },
527 parents => [$ctx1, $ctx, $ctx2],
528 ;
529
530=back
531
532=cut
533
534sub new {
535 my $class = shift;
536
537 my $ctx = AnyEvent::Log::ctx undef;
538
539 while (@_) {
540 my ($k, $v) = splice @_, 0, 2;
541 $ctx->$k (ref $v eq "ARRAY" ? @$v : $v);
542 }
543
544 bless $ctx, $class # do we really support subclassing, hmm?
545}
546
437 547
438=head2 CONFIGURING A LOG CONTEXT 548=head2 CONFIGURING A LOG CONTEXT
439 549
440The following methods can be used to configure the logging context. 550The following methods can be used to configure the logging context.
441 551
559Removes the given parents from this context - it's not an error to attempt 669Removes the given parents from this context - it's not an error to attempt
560to remove a context that hasn't been added. 670to remove a context that hasn't been added.
561 671
562A context can be specified either as package name or as a context object. 672A context can be specified either as package name or as a context object.
563 673
674=item $ctx->parents ($ctx2[, $ctx3...])
675
676Replaces all parents attached to this context by the ones given.
677
564=cut 678=cut
565 679
566sub attach { 680sub attach {
567 my $ctx = shift; 681 my $ctx = shift;
568 682
573sub detach { 687sub detach {
574 my $ctx = shift; 688 my $ctx = shift;
575 689
576 delete $ctx->[2]{$_+0} 690 delete $ctx->[2]{$_+0}
577 for map { AnyEvent::Log::ctx $_ } @_; 691 for map { AnyEvent::Log::ctx $_ } @_;
692}
693
694sub parents {
695 undef $_[0][2];
696 &attach;
578} 697}
579 698
580=back 699=back
581 700
582=head3 MESSAGE LOGGING 701=head3 MESSAGE LOGGING
682 801
6831; 8021;
684 803
685=back 804=back
686 805
806=head1 EXAMPLES
807
808This section shows some common configurations.
809
810=over 4
811
812=item Setting the global logging level.
813
814Either put PERL_ANYEVENT_VERBOSE=<number> into your environment before
815running your program, or modify the log level of the root context:
816
817 PERL_ANYEVENT_VERBOSE=5 ./myprog
818
819 $AnyEvent::Log::Root->level ("warn");
820
821=item Append all messages to a file instead of sending them to STDERR.
822
823This is affected by the global logging level.
824
825 open my $fh, ">>", $path
826 or die "$path: $!";
827
828 $AnyEvent::Log::Default->log_cb (sub {
829 syswrite $fh, shift;
830 0
831 });
832
833=item Write all messages with priority C<error> and higher to a file.
834
835This writes them only when the global logging level allows it, because
836it is attached to the default context which is invoked I<after> global
837filtering.
838
839 open my $fh, ">>", $path
840 or die "$path: $!";
841
842 $AnyEvent::Log::Default->attach (new AnyEvent::Log::Ctx
843 log_cb => sub { syswrite $fh, shift; 0 });
844
845This writes them regardless of the global logging level, because it is
846attached to the toplevel context, which receives all messages I<before>
847the global filtering.
848
849 $AnyEvent::Log::Top->attach (new AnyEvent::Log::Ctx
850 log_cb => sub { syswrite $fh, shift; 0 });
851
852In both cases, messages are still written to STDOUT.
853
854=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
855
856Attach the CyAnyEvent::Log::Default> context to the C<AnyEvent::Debug>
857context and increase the C<AnyEvent::Debug> logging level - this simply
858circumvents the global filtering for trace messages.
859
860 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
861 $debug->attach ($AnyEvent::Log::Default);
862 $debug->levels ("trace"); # not "level"!
863
864This of course works for any package.
865
866=back
867
687=head1 AUTHOR 868=head1 AUTHOR
688 869
689 Marc Lehmann <schmorp@schmorp.de> 870 Marc Lehmann <schmorp@schmorp.de>
690 http://home.schmorp.de/ 871 http://home.schmorp.de/
691 872

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines