--- AnyEvent/lib/AnyEvent/Log.pm 2011/08/17 02:02:38 1.3 +++ AnyEvent/lib/AnyEvent/Log.pm 2011/08/25 00:14:32 1.29 @@ -4,8 +4,39 @@ =head1 SYNOPSIS +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!"; # never returns + +"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 (also look at the EXAMPLES section): + + # set logging for the current package to errors and higher only + AnyEvent::Log::ctx->level ("error"); + + # set logging level to suppress anything below "notice" + $AnyEvent::Log::FILTER->level ("notice"); + + # 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 => 0, + ); + =head1 DESCRIPTION This module implements a relatively simple "logging framework". It doesn't @@ -14,20 +45,60 @@ module more or less exposes the mechanism, with some extra spiff to allow using it from other modules as well. -Remember that the default verbosity level is C<0>, so nothing -will be logged, ever, unless you set C<$Anyvent::VERBOSE> or -C to a higher number. - -Possible future extensions are to allow custom log targets (where the -level is an object), log filtering based on package, formatting, aliasing -or package groups. +Remember that the default verbosity level is C<0> (C), so nothing +will be logged, unless you set C to a higher number +before starting your program, or change the logging level at runtime with +something like: -=head1 LOG FUNCTIONS + use AnyEvent::Log; + 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 amount of documentation might indicate otherwise, but 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 +priority, so when this document says "higher priority" it means "lower +numerical value". + +Instead of specifying levels by name you can also specify them by aliases: + + LVL NAME SYSLOG PERL NOTE + 1 fatal emerg exit aborts program! + 2 alert + 3 critical crit + 4 error err die + 5 warn warning + 6 note notice + 7 info + 8 debug + 9 trace + +As you can see, some logging levels have multiple aliases - the first one +is the "official" name, the second one the "syslog" name (if it differs) +and the third one the "perl" name, suggesting that you log C messages +at C priority. + +You can normally only log a single message at highest priority level +(C<1>, C), because logging a fatal message will also quit the +program - so use it sparingly :) + +Some methods also offer some extra levels, such as C<0>, C, C +or C - these are only valid in the methods they are documented for. + +=head1 LOGGING FUNCTIONS These functions allow you to log messages. They always use the caller's -package as a "logging module/source". Also, The main logging function is -easily available as C or C when the C -module is loaded. +package as a "logging context". Also, the main logging function C is +callable as C or C when the C module is +loaded. =over 4 @@ -41,6 +112,10 @@ use AnyEvent (); BEGIN { AnyEvent::common_sense } use AnyEvent::Util (); +our $VERSION = $AnyEvent::VERSION; + +our ($COLLECT, $FILTER, $LOG); + our ($now_int, $now_str1, $now_str2); # Format Time, not public - yet? @@ -54,14 +129,26 @@ "$now_str1$f$now_str2" } -our %CFG; #TODO +our %CTX; # all package contexts + +# creates a default package context object for the given package +sub _pkg_ctx($) { + my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx"; + + # link "parent" package + my $parent = $_[0] =~ /^(.+)::/ + ? $CTX{$1} ||= &_pkg_ctx ("$1") + : $COLLECT; + + $ctx->[2]{$parent+0} = $parent; + + $ctx +} =item AnyEvent::Log::log $level, $msg[, @args] -Requests logging of the given C<$msg> with the given log level (1..9). -You can also use the following strings as log level: C (1), -C (2), C (3), C (4), C (5), C (6), -C (7), C (8), C (9). +Requests logging of the given C<$msg> with the given log level, and +returns true if the message was logged I. For C log levels, the program will abort. @@ -77,11 +164,19 @@ 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 detects a +runtime error it tries to log it at C level, but if that message is +lost it simply uses warn. Note that you can (and should) call this function as C or -C, without C-ing this module if possible, as those functions -will laod the logging module on demand only. +C, without C-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. + +Also, if you optionally generate a lot of debug messages (such as when +tracing some code), you should look into using a logger callback and a +boolean enabler (see C, below). Example: log something at error level. @@ -99,10 +194,10 @@ # also allow syslog equivalent names our %STR2LEVEL = ( - fatal => 1, emerg => 1, + fatal => 1, emerg => 1, exit => 1, alert => 2, critical => 3, crit => 3, - error => 4, err => 4, + error => 4, err => 4, die => 4, warn => 5, warning => 5, note => 6, notice => 6, info => 7, @@ -110,37 +205,80 @@ trace => 9, ); -our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace); - -sub _log { - my ($pkg, $targ, $msg, @args) = @_; +sub now () { time } - my $level = ref $targ ? die "Can't use reference as logging level (yet)" - : $targ > 0 && $targ <= 9 ? $targ+0 - : $STR2LEVEL{$targ} || Carp::croak "$targ: not a valid logging level, caught"; +AnyEvent::post_detect { + *now = \&AE::now; +}; - return if $level > $AnyEvent::VERBOSE; +our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace); - $msg = $msg->() if ref $msg; - $msg = sprintf $msg, @args if @args; - $msg =~ s/\n$//; +# time, ctx, level, msg +sub _format($$$$) { + my $ts = ft $_[0]; + my $ct = " "; + + my @res; + + for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) { + push @res, "$ts$ct$_\n"; + $ct = " + "; + } - # now we have a message, log it - #TODO: could do LOTS of stuff here, and should, at least in some later version + join "", @res +} - $msg = sprintf "%5s %s: %s", $LEVEL2STR[$level], $pkg, $msg; - my $pfx = ft AE::now; +sub _log { + my ($ctx, $level, $format, @args) = @_; - for (split /\n/, $msg) { - printf STDERR "$pfx $_\n"; - $pfx = "\t"; - } + $level = $level > 0 && $level <= 9 + ? $level+0 + : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; + + my $mask = 1 << $level; + + my ($success, %seen, @ctx, $now, $fmt); + + do + { + # skip if masked + if ($ctx->[1] & $mask && !$seen{$ctx+0}++) { + if ($ctx->[3]) { + # logging target found + + # 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; + }; + + # format msg + my $str = $ctx->[4] + ? $ctx->[4]($now, $_[0], $level, $format) + : ($fmt ||= _format $now, $_[0], $level, $format); + + $success = 1; + + $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 +(caller)[0], @_; + _log + $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], + @_; } *AnyEvent::log = *AE::log = \&log; @@ -148,7 +286,7 @@ =item $logger = AnyEvent::Log::logger $level[, \$enabled] Creates a code reference that, when called, acts as if the -C function was called at this point with the givne +C 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 function: @@ -183,43 +321,36 @@ $debug and $debug_log->("123"); -Note: currently the enabled var is always true - that will be fixed in a -future version :) - =cut our %LOGGER; # re-assess logging status for all loggers sub _reassess { + local $SIG{__DIE__}; + my $die = sub { die }; + for (@_ ? $LOGGER{$_[0]} : values %LOGGER) { - my ($pkg, $level, $renabled) = @$_; + my ($ctx, $level, $renabled) = @$_; - # to detetc whether a message would be logged, we # actually - # try to log one and die. this isn't # fast, but we can be + # to detect whether a message would be logged, we actually + # try to log one and die. this isn't fast, but we can be # sure that the logging decision is correct :) $$renabled = !eval { - local $SIG{__DIE__}; - - _log $pkg, $level, sub { die }; + _log $ctx, $level, $die; 1 }; - - $$renabled = 1; # TODO } } -sub logger($;$) { - my ($level, $renabled) = @_; - - $renabled ||= \my $enabled; - my $pkg = (caller)[0]; +sub _logger { + my ($ctx, $level, $renabled) = @_; $$renabled = 1; - my $logger = [$pkg, $level, $renabled]; + my $logger = [$ctx, $level, $renabled]; $LOGGER{$logger+0} = $logger; @@ -233,25 +364,858 @@ sub { $guard if 0; # keep guard alive, but don't cause runtime overhead - _log $pkg, $level, @_ + _log $ctx, $level, @_ if $$renabled; } } -#TODO +sub logger($;$) { + _logger + $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], + @_ +} + +=back + +=head1 LOGGING CONTEXTS + +This module associates every log message with a so-called I, based on the package of the caller. Every perl package has its +own logging context. + +A logging context has three major responsibilities: filtering, logging and +propagating the message. + +For the first purpose, filtering, each context has a set of logging +levels, called the log level mask. Messages not in the set will be ignored +by this context (masked). + +For logging, the context stores a formatting callback (which takes the +timestamp, context, level and string message and formats it in the way +it should be logged) and a logging callback (which is responsible for +actually logging the formatted message and telling C +whether it has consumed the message, or whether it should be propagated). + +For propagation, a context can have any number of attached I. Any message that is neither masked by the logging mask nor +masked by the logging callback returning true will be passed to all slave +contexts. + +Each call to a logging function will log the message at most once per +context, so it does not matter (much) if there are cycles or if the +message can arrive at the same context via multiple paths. + +=head2 DEFAULTS + +By default, all logging contexts have an full set of log levels ("all"), a +disabled logging callback and the default formatting callback. + +Package contexts have the package name as logging title by default. + +They have exactly one slave - the context of the "parent" package. The +parent package is simply defined to be the package name without the last +component, i.e. C becomes C, +and C becomes ... C<$AnyEvent::Log::COLLECT> which is the +exception of the rule - just like the "parent" of any single-component +package name in Perl is C
, the default slave of any top-level +package context is C<$AnyEvent::Log::COLLECT>. + +Since perl packages form only an approximate hierarchy, this slave +context can of course be removed. + +All other (anonymous) contexts have no slaves and an empty title by +default. + +When the module is loaded it creates the C<$AnyEvent::Log::LOG> logging +context that simply logs everything via C, without propagating +anything anywhere by default. The purpose of this context is to provide +a convenient place to override the global logging target or to attach +additional log targets. It's not meant for filtering. + +It then creates the C<$AnyEvent::Log::FILTER> context whose +purpose is to suppress all messages with priority higher +than C<$ENV{PERL_ANYEVENT_VERBOSE}>. It then attached the +C<$AnyEvent::Log::LOG> context to it. The purpose of the filter context +is to simply provide filtering according to some global log level. + +Finally it creates the top-level package context C<$AnyEvent::Log::COLLECT> +and attaches the C<$AnyEvent::Log::FILTER> context to it, but otherwise +leaves it at default config. Its purpose is simply to collect all log +messages system-wide. + +The hierarchy is then: + + any package, eventually -> $COLLECT -> $FILTER -> $LOG + +The effect of all this is that log messages, by default, wander up to the +C<$AnyEvent::Log::COLLECT> context where all messages normally end up, +from there to C<$AnyEvent::Log::FILTER> where log messages with lower +priority then C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered out and then +to the C<$AnyEvent::Log::LOG> context to be passed to C. + +This makes it easy to set a global logging level (by modifying $FILTER), +but still allow other contexts to send, for example, their debug and trace +messages to the $LOG target despite the global logging level, or to attach +additional log targets that log messages, regardless of the global logging +level. + +It also makes it easy to modify the default warn-logger ($LOG) to +something that logs to a file, or to attach additional logging targets +(such as loggign to a file) by attaching it to $FILTER. + +=head2 CREATING/FINDING/DESTROYING CONTEXTS + +=over 4 + +=item $ctx = AnyEvent::Log::ctx [$pkg] + +This function creates or returns a logging context (which is an object). + +If a package name is given, then the context for that packlage is +returned. If it is called without any arguments, then the context for the +callers package is returned (i.e. the same context as a C call +would use). + +If C is given, then it creates a new anonymous context that is not +tied to any package and is destroyed when no longer referenced. + +=cut + +sub ctx(;$) { + my $pkg = @_ ? shift : (caller)[0]; + + ref $pkg + ? $pkg + : defined $pkg + ? $CTX{$pkg} ||= AnyEvent::Log::_pkg_ctx $pkg + : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx" +} + +=item AnyEvent::Log::reset + +Resets all package contexts and recreates the default hierarchy if +necessary, i.e. resets the logging subsystem to defaults, as much as +possible. This process keeps references to contexts held by other parts of +the program intact. + +This can be used to implement config-file (re-)loading: before loading a +configuration, reset all contexts. + +=cut + +sub reset { + # hard to kill complex data structures + # we "recreate" all package loggers and reset the hierarchy + while (my ($k, $v) = each %CTX) { + @$v = ($k, (1 << 10) - 1 - 1, { }); + + $v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log::COLLECT); + } + + @$_ = ($_->[0], (1 << 10) - 1 - 1) + for $LOG, $FILTER, $COLLECT; + + $LOG->slaves; + $LOG->title ('$AnyEvent::Log::LOG'); + $LOG->log_to_warn; + + $FILTER->slaves ($LOG); + $FILTER->title ('$AnyEvent::Log::FILTER'); + $FILTER->level ($AnyEvent::VERBOSE); + + $COLLECT->slaves ($FILTER); + $COLLECT->title ('$AnyEvent::Log::COLLECT'); + + _reassess; +} + +# create the default logger contexts +$LOG = ctx undef; +$FILTER = ctx undef; +$COLLECT = ctx undef; + +AnyEvent::Log::reset; + +# hello, CPAN, please catch me +package AnyEvent::Log::LOG; +package AE::Log::LOG; +package AnyEvent::Log::FILTER; +package AE::Log::FILTER; +package AnyEvent::Log::COLLECT; +package AE::Log::COLLECT; + +package AnyEvent::Log::Ctx; + +# 0 1 2 3 4 +# [$title, $level, %$slaves, &$logcb, &$fmtcb] + +=item $ctx = new AnyEvent::Log::Ctx methodname => param... + +This is a convenience constructor that makes it simpler to construct +anonymous logging contexts. + +Each key-value pair results in an invocation of the method of the same +name as the key with the value as parameter, unless the value is an +arrayref, in which case it calls the method with the contents of the +array. The methods are called in the same order as specified. + +Example: create a new logging context and set both the default logging +level, some slave contexts and a logging callback. + + $ctx = new AnyEvent::Log::Ctx + title => "dubious messages", + level => "error", + log_cb => sub { print STDOUT shift; 0 }, + slaves => [$ctx1, $ctx, $ctx2], + ; + +=back + +=cut + +sub new { + my $class = shift; + + my $ctx = AnyEvent::Log::ctx undef; + + while (@_) { + my ($k, $v) = splice @_, 0, 2; + $ctx->$k (ref $v eq "ARRAY" ? @$v : $v); + } + + bless $ctx, $class # do we really support subclassing, hmm? +} + + +=head2 CONFIGURING A LOG CONTEXT + +The following methods can be used to configure the logging context. + +=over 4 + +=item $ctx->title ([$new_title]) + +Returns the title of the logging context - this is the package name, for +package contexts, and a user defined string for all others. + +If C<$new_title> is given, then it replaces the package name or title. + +=cut + +sub title { + $_[0][0] = $_[1] if @_ > 1; + $_[0][0] +} + +=back + +=head3 LOGGING LEVELS + +The following methods deal with the logging level set associated with the +log context. + +The most common method to use is probably C<< $ctx->level ($level) >>, +which configures the specified and any higher priority levels. + +All functions which accept a list of levels also accept the special string +C which expands to all logging levels. + +=over 4 + +=item $ctx->levels ($level[, $level...) + +Enables logging for the given levels and disables it for all others. + +=item $ctx->level ($level) + +Enables logging for the given level and all lower level (higher priority) +ones. In addition to normal logging levels, specifying a level of C<0> or +C disables all logging for this level. + +Example: log warnings, errors and higher priority messages. + + $ctx->level ("warn"); + $ctx->level (5); # same thing, just numeric + +=item $ctx->enable ($level[, $level...]) + +Enables logging for the given levels, leaving all others unchanged. + +=item $ctx->disable ($level[, $level...]) + +Disables logging for the given levels, leaving all others unchanged. + +=cut + +sub _lvl_lst { + map { + $_ > 0 && $_ <= 9 ? $_+0 + : $_ eq "all" ? (1 .. 9) + : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" + } @_ +} + +our $NOP_CB = sub { 0 }; + +sub levels { + my $ctx = shift; + $ctx->[1] = 0; + $ctx->[1] |= 1 << $_ + for &_lvl_lst; + AnyEvent::Log::_reassess; +} + +sub level { + my $ctx = shift; + my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]; + + $ctx->[1] = ((1 << $lvl) - 1) << 1; + AnyEvent::Log::_reassess; +} + +sub enable { + my $ctx = shift; + $ctx->[1] |= 1 << $_ + for &_lvl_lst; + AnyEvent::Log::_reassess; +} + +sub disable { + my $ctx = shift; + $ctx->[1] &= ~(1 << $_) + for &_lvl_lst; + AnyEvent::Log::_reassess; +} + +=back + +=head3 SLAVE CONTEXTS + +The following methods attach and detach another logging context to a +logging context. + +Log messages are propagated to all slave contexts, unless the logging +callback consumes the message. + +=over 4 + +=item $ctx->attach ($ctx2[, $ctx3...]) + +Attaches the given contexts as slaves to this context. It is not an error +to add a context twice (the second add will be ignored). + +A context can be specified either as package name or as a context object. + +=item $ctx->detach ($ctx2[, $ctx3...]) + +Removes the given slaves from this context - it's not an error to attempt +to remove a context that hasn't been added. + +A context can be specified either as package name or as a context object. + +=item $ctx->slaves ($ctx2[, $ctx3...]) + +Replaces all slaves attached to this context by the ones given. + +=cut + +sub attach { + my $ctx = shift; + + $ctx->[2]{$_+0} = $_ + for map { AnyEvent::Log::ctx $_ } @_; +} + +sub detach { + my $ctx = shift; + + delete $ctx->[2]{$_+0} + for map { AnyEvent::Log::ctx $_ } @_; +} + +sub slaves { + undef $_[0][2]; + &attach; +} + +=back + +=head3 LOG TARGETS + +The following methods configure how the logging context actually does +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) + +Replaces the logging callback on the context (C disables the +logging callback). + +The logging callback is responsible for handling formatted log messages +(see C below) - normally simple text strings that end with a +newline (and are possibly multiline themselves). + +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. + +Example: a very simple logging callback, simply dump the message to STDOUT +and do not consume it. + + $ctx->log_cb (sub { print STDERR shift; 0 }); + +You can filter messages by having a log callback that simply returns C<1> +and does not do anything with the message, but this counts as "message +being logged" and might not be very efficient. + +Example: propagate all messages except for log levels "debug" and +"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->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message)) + +Replaces the formatting callback on the context (C restores the +default formatter). + +The callback is passed the (possibly fractional) timestamp, the original +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 reason, you want to use C to find out more baout the +logger then you should walk up the call stack until you are no longer +inside the C package. + +Example: format just the raw message, with numeric log level in angle +brackets. + + $ctx->fmt_cb (sub { + my ($time, $ctx, $lvl, $msg) = @_; + + "<$lvl>$msg\n" + }); + +Example: return an array reference with just the log values, and use +C to store the emssage in a database. + + $ctx->fmt_cb (sub { \@_ }); + $ctx->log_cb (sub { + my ($msg) = @_; + + sql_exec "insert into log (when, subsys, prio, msg) values (?, ?, ?, ?)", + $msg->[0] + 0, + "$msg->[1]", + $msg->[2] + 0, + "$msg->[3]"; + + 0 + }); + +=item $ctx->log_to_warn + +Sets the C to simply use C to report any messages +(usually this logs to STDERR). + +=item $ctx->log_to_file ($path) + +Sets the C 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, the path should be absolute. Doesn't help with +C, but hey... + +=item $ctx->log_to_syslog ([$log_flags]) + +Logs all messages via L, mapping C to C 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 +flags valid for Sys::Syslog::syslog, except for the priority levels. + +Note that this function also sets a C - the logging part requires +an array reference with [$level, $str] as input. + +=cut + +sub log_cb { + my ($ctx, $cb) = @_; + + $ctx->[3] = $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) = @_; + + open my $fh, ">>", $path + or die "$path: $!"; + + $ctx->log_cb (sub { + syswrite $fh, shift; + 0 + }); +} + +sub log_to_path { + my ($ctx, $path) = @_; + + $ctx->log_cb (sub { + open my $fh, ">>", $path + or die "$path: $!"; + + syswrite $fh, shift; + 0 + }); +} + +sub log_to_syslog { + my ($ctx, $flags) = @_; + + require Sys::Syslog; + + $ctx->fmt_cb (sub { + my $str = $_[3]; + $str =~ s/\n(?=.)/\n+ /g; + + [$_[2], "($_[1][0]) $str"] + }); + + $ctx->log_cb (sub { + my $lvl = $_[0][0] < 9 ? $_[0][0] : 8; + + Sys::Syslog::syslog ($flags | ($lvl - 1), $_) + for split /\n/, $_[0][1]; + + 0 + }); +} + +=back + +=head3 MESSAGE LOGGING + +These methods allow you to log messages directly to a context, without +going via your package context. + +=over 4 + +=item $ctx->log ($level, $msg[, @params]) + +Same as C, but uses the given context as log context. + +=item $logger = $ctx->logger ($level[, \$enabled]) + +Same as C, but uses the given context as log +context. + +=cut + +*log = \&AnyEvent::Log::_log; +*logger = \&AnyEvent::Log::_logger; =back -=head1 CONFIGURATION FUNCTIONALITY +=cut + +package AnyEvent::Log; + +=head1 CONFIGURATION VIA $ENV{PERL_ANYEVENT_LOG} + +Logging can also be configured by setting the environment variable +C (or C). + +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 + +Since whitespace (which includes newlines) is allowed, it is fine to +specify multiple lines in C, e.g.: + + PERL_ANYEVENT_LOG=" + filter=warn + AnyEvent::Debug=+%trace + %trace=only,trace,+log + " myprog + +A context name in the log specification can be any of the following: + +=over 4 + +=item C, C, C + +Correspond to the three predefined C<$AnyEvent::Log::COLLECT>, +C 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. -None, yet, except for C, described in the L manpage. +=item a perl package name + +Any other string references the logging context associated with the given +Perl C. 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 + +Configures the context to use Perl's C function (which typically +logs to C). Works like C. + +=item CI + +Configures the context to log to a file with the given path. Works like +C. + +=item CI + +Configures the context to log to a file with the given path. Works like +C. + +=item C or CI + +Configured the context to log to syslog. If I is given, then it is +evaluated in the L package, so you could use: + + log=syslog=LOG_LOCAL0 + +=item C + +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 + +Sets the logging level of the context ot C<0>, i.e. all messages will be +filtered out. + +=item C + +Enables all logging levels, i.e. filtering will effectively be switched +off (the default). + +=item C + +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 + +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 + +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>, a logging level name (C, C etc.) + +A numeric loglevel or the name of a loglevel will be interpreted according +to the most recent C, C or C directive. By default, +specifying a logging level enables that and any higher priority messages. + +=item C<+>I + +Adds/attaches the named context as slave to the context. + +=item C<+> + +A line C<+> clears the slave list form the context. Anonymous (C<%name>) +contexts have no 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 + =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 (eval "package Sys::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; +=head1 EXAMPLES + +This section shows some common configurations, both as code, and as +C string. + +=over 4 + +=item Setting the global logging level. + +Either put C into your environment before +running your program, use C 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); + + PERL_ANYEVENT_LOG=log=file=/some/path + +=item Write all messages with priority C 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 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 +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 to the default logging target(s). + +Attach the C<$AnyEvent::Log::LOG> context to the C +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, but +assumes the log level for AnyEvent::Debug hasn't been changed from the +default. + =back =head1 AUTHOR @@ -260,3 +1224,4 @@ http://home.schmorp.de/ =cut +