[ViewVC] Diff of: cvs/AnyEvent/lib/AnyEvent/Log.pm

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents):
Revision 1.20 by root, Sat Aug 20 22:27:07 2011 UTC vs.
Revision 1.40 by root, Fri Aug 26 16:18:01 2011 UTC

 AnyEvent::Log - simple logging "framework"
 =head1 SYNOPSIS
-   # simple use
+Simple uses:
    use AnyEvent;
    AE::log debug => "hit my knee";
    AE::log warn  => "it's a bit too hot";
    AE::log error => "the flag was false!";
-   AE::log fatal => "the bit toggled! run!";
+   AE::log fatal => "the bit toggled! run!"; # never returns
-   # "complex" use
+"Complex" uses (for speed sensitive code):
    use AnyEvent::Log;
    my $tracer = AnyEvent::Log::logger trace => \$my $trace;
    $tracer->("i am here") if $trace;
    $tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
-   # configuration
+Configuration (also look at the EXAMPLES section):
    # set logging for the current package to errors and higher only
    AnyEvent::Log::ctx->level ("error");
-   # set logging globally to anything below debug
+   # set logging level to suppress anything below "notice"
    $AnyEvent::Log::FILTER->level ("notice");
-   # see also EXAMPLES, below
+   # send all critical and higher priority messages to syslog,
+   # regardless of (most) other settings
+   $AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx
+      level         => "critical",
+      log_to_syslog => "user",
+   );
 =head1 DESCRIPTION
 This module implements a relatively simple "logging framework". It doesn't
 attempt to be "the" logging solution or even "a" logging solution for
 will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
 before starting your program, or change the logging level at runtime with
 something like:
    use AnyEvent::Log;
-   AnyEvent::Log::FILTER->level ("info");
+   $AnyEvent::Log::FILTER->level ("info");
 The design goal behind this module was to keep it simple (and small),
 but make it powerful enough to be potentially useful for any module, and
 extensive enough for the most common tasks, such as logging to multiple
 targets, or being able to log into a database.
+The module is also usable before AnyEvent itself is initialised, in which
+case some of the functionality might be reduced.
-The amount of documentation might indicate otherwise, but the module is
+The amount of documentation might indicate otherwise, but the runtime part
-still just below 300 lines of code.
+of the module is still just below 300 lines of code.
 =head1 LOGGING LEVELS
 Logging levels in this module range from C<1> (highest priority) to C<9>
 (lowest priority). Note that the lowest numerical value is the highest
 use Carp ();
 use POSIX ();
 use AnyEvent (); BEGIN { AnyEvent::common_sense }
-use AnyEvent::Util ();
+#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log
 our $VERSION = $AnyEvent::VERSION;
 our ($COLLECT, $FILTER, $LOG);
    $ctx
 }
 =item AnyEvent::Log::log $level, $msg[, @args]
-Requests logging of the given C<$msg> with the given log level.
+Requests logging of the given C<$msg> with the given log level, and
+returns true if the message was logged I<somewhere>.
 For C<fatal> log levels, the program will abort.
 If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the
 C<$msg> is interpreted as an sprintf format string.
 supposed to return the message. It will be called only then the message
 actually gets logged, which is useful if it is costly to create the
 message in the first place.
 Whether the given message will be logged depends on the maximum log level
-and the caller's package.
+and the caller's package. The return value can be used to ensure that
+messages or not "lost" - for example, when L<AnyEvent::Debug> detects a
+runtime error it tries to log it at C<die> level, but if that message is
+lost it simply uses warn.
 Note that you can (and should) call this function as C<AnyEvent::log> or
 C<AE::log>, without C<use>-ing this module if possible (i.e. you don't
 need any additional functionality), as those functions will load the
 logging module on demand only. They are also much shorter to write.
    info     => 7,
    debug    => 8,
    trace    => 9,
 );
-sub now () { time }
+our $TIME_EXACT;
+sub exact_time($) {
+   $TIME_EXACT = shift;
+   *_ts = $AnyEvent::MODEL
+      ? $TIME_EXACT ? \&AE::now : \&AE::time
+      : sub () { $TIME_EXACT ? do { require Time::HiRes; Time::HiRes::time () } : time };
+}
+BEGIN {
+   exact_time 0;
+}
 AnyEvent::post_detect {
-   *now = \&AE::now;
+   exact_time $TIME_EXACT;
 };
 our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
 # time, ctx, level, msg
             ? $level+0
             : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
    my $mask = 1 << $level;
-   my (%seen, @ctx, $now, $fmt);
+   my ($success, %seen, @ctx, $now, $fmt);
    do
       {
          # skip if masked
          if ($ctx->[1] & $mask && !$seen{$ctx+0}++) {
                # now get raw message, unless we have it already
                unless ($now) {
                   $format = $format->() if ref $format;
                   $format = sprintf $format, @args if @args;
                   $format =~ s/\n$//;
-                  $now = AE::now;
+                  $now = _ts;
                };
                # format msg
                my $str = $ctx->[4]
                   ? $ctx->[4]($now, $_[0], $level, $format)
                   : ($fmt ||= _format $now, $_[0], $level, $format);
+               $success = 1;
-               $ctx->[3]($str, $_[0], $level)
+               $ctx->[3]($str)
                   or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
             } else {
                push @ctx, values %{ $ctx->[2] }; # not masked - propagate
             }
          }
       }
    while $ctx = pop @ctx;
    exit 1 if $level <= 1;
+   $success
 }
 sub log($$;@) {
    _log
       $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
 *AnyEvent::log = *AE::log = \&log;
 =item $logger = AnyEvent::Log::logger $level[, \$enabled]
 Creates a code reference that, when called, acts as if the
-C<AnyEvent::Log::log> function was called at this point with the givne
+C<AnyEvent::Log::log> function was called at this point with the given
 level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
 the C<AnyEvent::Log::log> function:
    my $debug_log = AnyEvent::Log::logger "debug";
    $LOGGER{$logger+0} = $logger;
    _reassess $logger+0;
+   require AnyEvent::Util;
-   my $guard = AnyEvent::Util::guard {
+   my $guard = AnyEvent::Util::guard (sub {
       # "clean up"
       delete $LOGGER{$logger+0};
-   };
+   });
    sub {
       $guard if 0; # keep guard alive, but don't cause runtime overhead
       _log $ctx, $level, @_
 sub logger($;$) {
    _logger
       $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
       @_
 }
+=item AnyEvent::Log::exact_time $on
+By default, C<AnyEvent::Log> will use C<AE::now>, i.e. the cached
+eventloop time, for the log timestamps. After calling this function with a
+true value it will instead resort to C<AE::time>, i.e. fetch the current
+time on each log message. This only makes a difference for event loops
+that actually cache the time (such as L<EV> or L<AnyEvent::Loop>).
+This setting can be changed at any time by calling this function.
+Since C<AnyEvent::Log> has to work even before the L<AnyEvent> has been
+initialised, this switch will also decide whether to use C<CORE::time> or
+C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes
+available.
 =back
 =head1 LOGGING CONTEXTS
    }
    @$_ = ($_->[0], (1 << 10) - 1 - 1)
       for $LOG, $FILTER, $COLLECT;
-   $LOG->slaves;
+   #$LOG->slaves;
    $LOG->title ('$AnyEvent::Log::LOG');
-   $LOG->log_cb (sub {
+   $LOG->log_to_warn;
-      warn shift;
-      0
-   });
    $FILTER->slaves ($LOG);
    $FILTER->title ('$AnyEvent::Log::FILTER');
    $FILTER->level ($AnyEvent::VERBOSE);
 the logging (which consists of formatting the message and printing it or
 whatever it wants to do with it).
 =over 4
-=item $ctx->log_cb ($cb->($str, $orig_ctx, $level))
+=item $ctx->log_cb ($cb->($str)
 Replaces the logging callback on the context (C<undef> disables the
 logging callback).
 The logging callback is responsible for handling formatted log messages
 (see C<fmt_cb> below) - normally simple text strings that end with a
-newline (and are possibly multiline themselves). In addition to the
+newline (and are possibly multiline themselves).
-message, which is often the only argument you need to look at, it is
-passed the numeric log level and originating context.
 It also has to return true iff it has consumed the log message, and false
 if it hasn't. Consuming a message means that it will not be sent to any
 slave context. When in doubt, return C<0> from your logging callback.
 "trace". The messages will still be generated, though, which can slow down
 your program.
    $ctx->levels ("debug", "trace");
    $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
-=item $ctx->log_to_file ($path)
-Sets the C<log_cb> to log to a file (by appending), unbuffered.
-=item $ctx->log_to_path ($path)
-Same as C<< ->log_to_file >>, but opens the file for each message. This
-is much slower, but allows you to change/move/rename/delete the file at
-basically any time.
-=item $ctx->log_to_syslog ([$log_flags])
-Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and all
-the others in the obvious way. If specified, then the C<$log_flags> are
-simply or'ed onto the priority argument and can contain any C<LOG_xxx>
-flags valid for Sys::Syslog::syslog, except for the priority levels.
-Note that the default logging format includes a verbose timestamp, which
-is not so suited for syslog, so a simpler C<fmt_cb> might be useful:
-   $ctx->log_to_syslog;
-   $ctx->fmt_cb (sub { "($_[1][0]) $_[3]" });
 =item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
 Replaces the formatting callback on the context (C<undef> restores the
 default formatter).
 logging context, the (numeric) logging level and the raw message string
 and needs to return a formatted log message. In most cases this will be a
 string, but it could just as well be an array reference that just stores
 the values.
-If, for some reaosn, you want to use C<caller> to find out more baout the
+If, for some reason, you want to use C<caller> to find out more baout the
 logger then you should walk up the call stack until you are no longer
 inside the C<AnyEvent::Log> package.
 Example: format just the raw message, with numeric log level in angle
 brackets.
                "$msg->[3]";
       0
    });
+=item $ctx->log_to_warn
+Sets the C<log_cb> to simply use C<CORE::warn> to report any messages
+(usually this logs to STDERR).
+=item $ctx->log_to_file ($path)
+Sets the C<log_cb> to log to a file (by appending), unbuffered.
+=item $ctx->log_to_path ($path)
+Same as C<< ->log_to_file >>, but opens the file for each message. This
+is much slower, but allows you to change/move/rename/delete the file at
+basically any time.
+Needless(?) to say, if you do not want to be bitten by some evil person
+calling C<chdir>, the path should be absolute. Doesn't help with
+C<chroot>, but hey...
+=item $ctx->log_to_syslog ([$facility])
+Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and
+all the others in the obvious way. If specified, then the C<$facility> is
+used as the facility (C<user>, C<auth>, C<local0> and so on). The default
+facility is C<user>.
+Note that this function also sets a C<fmt_cb> - the logging part requires
+an array reference with [$level, $str] as input.
 =cut
 sub log_cb {
    my ($ctx, $cb) = @_;
 sub fmt_cb {
    my ($ctx, $cb) = @_;
    $ctx->[4] = $cb;
+}
+sub log_to_warn {
+   my ($ctx, $path) = @_;
+   $ctx->log_cb (sub {
+      warn shift;
+      0
+   });
 }
 sub log_to_file {
    my ($ctx, $path) = @_;
       syswrite $fh, shift;
       0
    });
 }
-sub log_to_file {
+sub log_to_path {
    my ($ctx, $path) = @_;
    $ctx->log_cb (sub {
       open my $fh, ">>", $path
          or die "$path: $!";
       0
    });
 }
 sub log_to_syslog {
-   my ($ctx, $flags) = @_;
+   my ($ctx, $facility) = @_;
    require Sys::Syslog;
+   $ctx->fmt_cb (sub {
+      my $str = $_[3];
+      $str =~ s/\n(?=.)/\n+ /g;
+      [$_[2], "($_[1][0]) $str"]
+   });
+   $facility ||= "user";
    $ctx->log_cb (sub {
-      my $lvl = $_[2] < 9 ? $_[2] : 8;
+      my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
-      Sys::Syslog::syslog ($flags | ($lvl - 1), $_)
+      Sys::Syslog::syslog ("$facility|" . ($lvl - 1), $_)
-         for split /\n/, shift;
+         for split /\n/, $_[0][1];
       0
    });
 }
 =cut
 *log    = \&AnyEvent::Log::_log;
 *logger = \&AnyEvent::Log::_logger;
+=back
+=cut
+package AnyEvent::Log;
+=head1 CONFIGURATION VIA $ENV{PERL_ANYEVENT_LOG}
+Logging can also be configured by setting the environment variable
+C<PERL_ANYEVENT_LOG> (or C<AE_LOG>).
+The value consists of one or more logging context specifications separated
+by C<:> or whitespace. Each logging specification in turn starts with a
+context name, followed by C<=>, followed by zero or more comma-separated
+configuration directives, here are some examples:
+   # set default logging level
+   filter=warn
+   # log to file instead of to stderr
+   log=file=/tmp/mylog
+   # log to file in addition to stderr
+   log=+%file:%file=file=/tmp/mylog
+   # enable debug log messages, log warnings and above to syslog
+   filter=debug:log=+%warnings:%warnings=warn,syslog=LOG_LOCAL0
+   # log trace messages (only) from AnyEvent::Debug to file
+   AnyEvent::Debug=+%trace:%trace=only,trace,file=/tmp/tracelog
+A context name in the log specification can be any of the following:
+=over 4
+=item C<collect>, C<filter>, C<log>
+Correspond to the three predefined C<$AnyEvent::Log::COLLECT>,
+C<AnyEvent::Log::FILTER> and C<$AnyEvent::Log::LOG> contexts.
+=item C<%name>
+Context names starting with a C<%> are anonymous contexts created when the
+name is first mentioned. The difference to package contexts is that by
+default they have no attached slaves.
+=item a perl package name
+Any other string references the logging context associated with the given
+Perl C<package>. In the unlikely case where you want to specify a package
+context that matches on of the other context name forms, you can add a
+C<::> to the package name to force interpretation as a package.
+=back
+The configuration specifications can be any number of the following:
+=over 4
+=item C<stderr>
+Configures the context to use Perl's C<warn> function (which typically
+logs to C<STDERR>). Works like C<log_to_warn>.
+=item C<file=>I<path>
+Configures the context to log to a file with the given path. Works like
+C<log_to_file>.
+=item C<path=>I<path>
+Configures the context to log to a file with the given path. Works like
+C<log_to_path>.
+=item C<syslog> or C<syslog=>I<expr>
+Configures the context to log to syslog. If I<expr> is given, then it is
+evaluated in the L<Sys::Syslog> package, so you could use:
+   log=syslog=LOG_LOCAL0
+=item C<nolog>
+Configures the context to not log anything by itself, which is the
+default. Same as C<< $ctx->log_cb (undef) >>.
+=item C<0> or C<off>
+Sets the logging level of the context ot C<0>, i.e. all messages will be
+filtered out.
+=item C<all>
+Enables all logging levels, i.e. filtering will effectively be switched
+off (the default).
+=item C<only>
+Disables all logging levels, and changes the interpretation of following
+level specifications to enable the specified level only.
+Example: only enable debug messages for a context.
+   context=only,debug
+=item C<except>
+Enables all logging levels, and changes the interpretation of following
+level specifications to disable that level. Rarely used.
+Example: enable all logging levels except fatal and trace (this is rather
+nonsensical).
+   filter=exept,fatal,trace
+=item C<level>
+Enables all logging levels, and changes the interpretation of following
+level specifications to be "that level or any higher priority
+message". This is the default.
+Example: log anything at or above warn level.
+   filter=warn
+   # or, more verbose
+   filter=only,level,warn
+=item C<1>..C<9> or a logging level name (C<error>, C<debug> etc.)
+A numeric loglevel or the name of a loglevel will be interpreted according
+to the most recent C<only>, C<except> or C<level> directive. By default,
+specifying a logging level enables that and any higher priority messages.
+=item C<+>I<context>
+Attaches the named context as slave to the context.
+=item C<+>
+A line C<+> detaches all contexts, i.e. clears the slave list from the
+context. Anonymous (C<%name>) contexts have no attached slaves by default,
+but package contexts have the parent context as slave by default.
+Example: log messages from My::Module to a file, do not send them to the
+default log collector.
+   My::Module=+,file=/tmp/mymodulelog
+=back
+Any character can be escaped by prefixing it with a C<\> (backslash), as
+usual, so to log to a file containing a comma, colon, backslash and some
+spaces in the filename, you would do this:
+   PERL_ANYEVENT_LOG='log=file=/some\ \:file\ with\,\ \\-escapes'
+Since whitespace (which includes newlines) is allowed, it is fine to
+specify multiple lines in C<PERL_ANYEVENT_LOG>, e.g.:
+   PERL_ANYEVENT_LOG="
+      filter=warn
+      AnyEvent::Debug=+%trace
+      %trace=only,trace,+log
+   " myprog
+Also, in the unlikely case when you want to concatenate specifications,
+use whitespace as separator, as C<::> will be interpreted as part of a
+module name, an empty spec with two separators:
+   PERL_ANYEVENT_LOG="$PERL_ANYEVENT_LOG MyMod=debug"
+=cut
+for (my $spec = $ENV{PERL_ANYEVENT_LOG}) {
+   my %anon;
+   my $pkg = sub {
+      $_[0] eq "log"              ? $LOG
+      : $_[0] eq "filter"         ? $FILTER
+      : $_[0] eq "collect"        ? $COLLECT
+      : $_[0] =~ /^%(.+)$/        ? ($anon{$1} ||= ctx undef)
+      : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/
+      : die # never reached?
+   };
+   /\G[[:space:]]+/gc; # skip initial whitespace
+   while (/\G((?:[^:=[:space:]]+|::|\\.)+)=/gc) {
+      my $ctx = $pkg->($1);
+      my $level = "level";
+      while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
+         for ("$1") {
+            if ($_ eq "stderr"               ) { $ctx->log_to_warn;
+            } elsif (/^file=(.+)/            ) { $ctx->log_to_file ("$1");
+            } elsif (/^path=(.+)/            ) { $ctx->log_to_path ("$1");
+            } elsif (/syslog(?:=(.*))?/      ) { require Sys::Syslog; $ctx->log_to_syslog ($1);
+            } elsif ($_ eq "nolog"           ) { $ctx->log_cb (undef);
+            } elsif (/^\+(.+)$/              ) { $ctx->attach ($pkg->("$1"));
+            } elsif ($_ eq "+"               ) { $ctx->slaves;
+            } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
+            } elsif ($_ eq "all"             ) { $ctx->level ("all");
+            } elsif ($_ eq "level"           ) { $ctx->level ("all"); $level = "level";
+            } elsif ($_ eq "only"            ) { $ctx->level ("off"); $level = "enable";
+            } elsif ($_ eq "except"          ) { $ctx->level ("all"); $level = "disable";
+            } elsif (/^\d$/                  ) { $ctx->$level ($_);
+            } elsif (exists $STR2LEVEL{$_}   ) { $ctx->$level ($_);
+            } else                             { die "PERL_ANYEVENT_LOG ($spec): parse error at '$_'\n";
+            }
+         }
+         /\G,/gc or last;
+      }
+      /\G[:[:space:]]+/gc or last;
+   }
+   /\G[[:space:]]+/gc; # skip trailing whitespace
+   if (/\G(.+)/g) {
+      die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n";
+   }
+}
 1;
-=back
 =head1 EXAMPLES
-This section shows some common configurations.
+This section shows some common configurations, both as code, and as
+C<PERL_ANYEVENT_LOG> string.
 =over 4
 =item Setting the global logging level.
-Either put PERL_ANYEVENT_VERBOSE=<number> into your environment before
+Either put C<PERL_ANYEVENT_VERBOSE=><number> into your environment before
-running your program, or modify the log level of the root context:
+running your program, use C<PERL_ANYEVENT_LOG> or modify the log level of
+the root context at runtime:
    PERL_ANYEVENT_VERBOSE=5 ./myprog
+   PERL_ANYEVENT_LOG=log=warn
    $AnyEvent::Log::FILTER->level ("warn");
 =item Append all messages to a file instead of sending them to STDERR.
 This is affected by the global logging level.
-   $AnyEvent::Log::LOG->log_to_file ($path); (sub {
+   $AnyEvent::Log::LOG->log_to_file ($path);
+   PERL_ANYEVENT_LOG=log=file=/some/path
 =item Write all messages with priority C<error> and higher to a file.
 This writes them only when the global logging level allows it, because
 it is attached to the default context which is invoked I<after> global
 filtering.
    $AnyEvent::Log::FILTER->attach
       new AnyEvent::Log::Ctx log_to_file => $path);
+   PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
 This writes them regardless of the global logging level, because it is
 attached to the toplevel context, which receives all messages I<before>
 the global filtering.
    $AnyEvent::Log::COLLECT->attach (
       new AnyEvent::Log::Ctx log_to_file => $path);
+   PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
 In both cases, messages are still written to STDERR.
 =item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
 Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
 context - this simply circumvents the global filtering for trace messages.
    my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
    $debug->attach ($AnyEvent::Log::LOG);
+   PERL_ANYEVENT_LOG=AnyEvent::Debug=+log
 This of course works for any package, not just L<AnyEvent::Debug>, but
 assumes the log level for AnyEvent::Debug hasn't been changed from the
 default.
  Marc Lehmann <schmorp@schmorp.de>
  http://home.schmorp.de/
 =cut

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents): Revision 1.20 by root, Sat Aug 20 22:27:07 2011 UTC vs. Revision 1.40 by root, Fri Aug 26 16:18:01 2011 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents):
Revision 1.20 by root, Sat Aug 20 22:27:07 2011 UTC vs.
Revision 1.40 by root, Fri Aug 26 16:18:01 2011 UTC