--- AnyEvent/lib/AnyEvent/Log.pm 2011/08/19 19:20:36 1.8 +++ AnyEvent/lib/AnyEvent/Log.pm 2019/03/11 20:48:19 1.66 @@ -4,24 +4,56 @@ =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 => "No config found, cannot continue!"; # never returns + AE::log alert => "The battery died!"; + AE::log crit => "The battery temperature is too hot!"; + AE::log error => "Division by zero attempted."; + AE::log warn => "Couldn't delete the file."; + AE::log note => "Wanted to create config, but config already exists."; + AE::log info => "File soandso successfully deleted."; + AE::log debug => "the function returned 3"; + AE::log trace => "going to call function abc"; + +Log level overview: + + LVL NAME SYSLOG PERL NOTE + 1 fatal emerg exit system unusable, aborts program! + 2 alert failure in primary system + 3 critical crit failure in backup system + 4 error err die non-urgent program errors, a bug + 5 warn warning possible problem, not necessarily error + 6 note notice unusual conditions + 7 info normal messages, no action required + 8 debug debugging messages for development + 9 trace copious tracing output + +"Complex" uses (for speed sensitive code, e.g. trace/debug messages): - # complex use use AnyEvent::Log; - my $tracer = AnyEvent::Log::logger trace => \$my $trace; + my $tracer = AnyEvent::Log::logger trace => \my $trace; $tracer->("i am here") if $trace; $tracer->(sub { "lots of data: " . Dumper $self }) if $trace; - #TODO: config - #TODO: ctx () becomes caller[0]... +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 => "user", + ); =head1 DESCRIPTION @@ -31,20 +63,74 @@ 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 to a higher number -before starting your program.#TODO - -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. - -=head1 LOG 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 -callable as C or C when the C module is -loaded. +Remember that the default verbosity level is C<4> (C), so only +errors and more important messages will be logged, unless you set +C to a higher number before starting your program +(C is recommended during development), or change the logging +level at runtime with something like: + + 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 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 runtime part +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 +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 system unusable, aborts program! + 2 alert failure in primary system + 3 critical crit failure in backup system + 4 error err die non-urgent program errors, a bug + 5 warn warning possible problem, not necessarily error + 6 note notice unusual conditions + 7 info normal messages, no action required + 8 debug debugging messages for development + 9 trace copious tracing output + +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 (only!) that you log C +messages at C priority. The NOTE column tries to provide some +rationale on how to chose a logging level. + +As a rough guideline, levels 1..3 are primarily meant for users of the +program (admins, staff), and are the only ones logged to STDERR by +default. Levels 4..6 are meant for users and developers alike, while +levels 7..9 are usually meant for developers. + +You can normally only log a message once at highest priority level (C<1>, +C), because logging a fatal message will also quit the program - so +use it sparingly :) + +For example, a program that finds an unknown switch on the commandline +might well use a fatal logging level to tell users about it - the "system" +in this case would be the program, or module. + +Some methods also offer some extra levels, such as C<0>, C, C +or C - these are only valid for the methods that documented them. + +=head1 LOGGING FUNCTIONS + +The following functions allow you to log messages. They always use the +caller's package as a "logging context". Also, the main logging function, +C, is aliased to C and C when the C +module is loaded. =over 4 @@ -55,13 +141,21 @@ use Carp (); use POSIX (); +# layout of a context +# 0 1 2 3 4, 5 +# [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap] + 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); our ($now_int, $now_str1, $now_str2); # Format Time, not public - yet? -sub ft($) { +sub format_time($) { my $i = int $_[0]; my $f = sprintf "%06d", 1e6 * ($_[0] - $i); @@ -71,31 +165,28 @@ "$now_str1$f$now_str2" } -our %CTX; # all logging contexts - -my $default_log_cb = sub { 0 }; +our %CTX; # all package contexts # creates a default package context object for the given package sub _pkg_ctx($) { - my $ctx = bless [$_[0], 0, {}, $default_log_cb], "AnyEvent::Log::Ctx"; + my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx"; # link "parent" package - my $pkg = $_[0] =~ /^(.+)::/ ? $1 : ""; + my $parent = $_[0] =~ /^(.+)::/ + ? $CTX{$1} ||= &_pkg_ctx ("$1") + : $COLLECT; - $pkg = $CTX{$pkg} ||= &_pkg_ctx ($pkg); - $ctx->[2]{$pkg+0} = $pkg; + $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. +For loglevel C, 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. @@ -108,15 +199,21 @@ actually gets logged, which is useful if it is costly to create the message in the first place. +This function takes care of saving and restoring C<$!> and C<$@>, so you +don't have to. + 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 (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 otpionally generate a lot of debug messages (such as when +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). @@ -136,10 +233,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, @@ -147,59 +244,102 @@ 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 -sub _format($$$$) { - my $pfx = ft $_[0]; +sub default_format($$$$) { + my $ts = format_time $_[0]; + my $ct = " "; + + my @res; + + for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) { + push @res, "$ts$ct$_\n"; + $ct = " + "; + } - join "", - map "$pfx $_\n", - split /\n/, - sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3] + join "", @res +} + +sub fatal_exit() { + exit 1; } sub _log { my ($ctx, $level, $format, @args) = @_; - $level = $level > 0 && $level <= 9 ? $level+0 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; + $level = $level > 0 && $level <= 9 + ? $level+0 + : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; my $mask = 1 << $level; - my $now = AE::now; - - my (@ctx, $did_format, $fmt); - - do { - if ($ctx->[1] & $mask) { - # logging target found - - # get raw message - unless ($did_format) { - $format = $format->() if ref $format; - $format = sprintf $format, @args if @args; - $format =~ s/\n$//; - $did_format = 1; - }; - # format msg - my $str = $ctx->[4] - ? $ctx->[4]($now, $_[0], $level, $format) - : $fmt ||= _format $now, $_[0], $level, $format; + my ($success, %seen, @ctx, $now, @fmt); - $ctx->[3]($str) - and next; + do + { + # if !ref, then it's a level number + if (!ref $ctx) { + $level = $ctx; + } elsif ($ctx->[1] & $mask and !$seen{$ctx+0}++) { + # logging/recursing into this context + + # level cap + if ($ctx->[5] > $level) { + push @ctx, $level; # restore level when going up in tree + $level = $ctx->[5]; + } + + # log if log cb + if ($ctx->[3]) { + # logging target found + + local ($!, $@); + + # 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 = _ts; + }; + + # format msg + my $str = $ctx->[4] + ? $ctx->[4]($now, $_[0], $level, $format) + : ($fmt[$level] ||= default_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; - # not consume - push parent contexts - push @ctx, values %{ $ctx->[2] }; - } while $ctx = pop @ctx; + fatal_exit if $level <= 1; - exit 1 if $level <= 1; + $success } sub log($$;@) { @@ -208,12 +348,10 @@ @_; } -*AnyEvent::log = *AE::log = \&log; - =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: @@ -248,39 +386,33 @@ $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 ($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 $ctx, $level, sub { die }; + _log $ctx, $level, $die; 1 }; - - $$renabled = 1; # TODO } } -sub _logger($;$) { +sub _logger { my ($ctx, $level, $renabled) = @_; - $renabled ||= \my $enabled; - $$renabled = 1; my $logger = [$ctx, $level, $renabled]; @@ -289,10 +421,11 @@ _reassess $logger+0; - my $guard = AnyEvent::Util::guard { + require AnyEvent::Util unless $AnyEvent::Util::VERSION; + 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 @@ -308,25 +441,156 @@ @_ } -#TODO +=item AnyEvent::Log::exact_time $on + +By default, C will use C, i.e. the cached +eventloop time, for the log timestamps. After calling this function with a +true value it will instead resort to C, 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 or L). + +This setting can be changed at any time by calling this function. + +Since C has to work even before the L has been +initialised, this switch will also decide whether to use C or +C when logging a message before L becomes +available. + +=item AnyEvent::Log::format_time $timestamp + +Formats a timestamp as returned by C<< AnyEvent->now >> or C<< +AnyEvent->time >> or many other functions in the same way as +C does. + +In your main program (as opposed to in your module) you can override +the default timestamp display format by loading this module and then +redefining this function. + +Most commonly, this function can be used in formatting callbacks. + +=item AnyEvent::Log::default_format $time, $ctx, $level, $msg + +Format a log message using the given timestamp, logging context, log level +and log message. + +This is the formatting function used to format messages when no custom +function is provided. + +In your main program (as opposed to in your module) you can override the +default message format by loading this module and then redefining this +function. + +=item AnyEvent::Log::fatal_exit() + +This is the function that is called after logging a C log +message. It must not return. + +The default implementation simply calls C. + +In your main program (as opposed to in your module) you can override +the fatal exit function by loading this module and then redefining this +function. Make sure you don't return. =back -=head1 CONFIGURATION FUNCTIONALITY +=head1 LOGGING CONTEXTS -None, yet, except for C, described in the L manpage. +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. -#TODO: wahst a context -#TODO +=head2 CREATING/FINDING/DESTROYING CONTEXTS =over 4 =item $ctx = AnyEvent::Log::ctx [$pkg] -Returns a I object for the given package name. +This function creates or returns a logging context (which is an object). -If no package name is given, returns the context for the current perl -package (i.e. the same context as a C call would use). +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. @@ -340,26 +604,118 @@ ? $pkg : defined $pkg ? $CTX{$pkg} ||= AnyEvent::Log::_pkg_ctx $pkg - : bless [undef, 0, undef, $default_log_cb], "AnyEvent::Log::Ctx" + : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx" } -# create default root context -{ - my $root = ctx undef; - $root->[0] = ""; - $root->title ("default"); - $root->level ($AnyEvent::VERBOSE); - $root->log_cb (sub { - print STDERR shift; - 0 - }); - $CTX{""} = $root; +=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 + +our $ORIG_VERBOSE = $AnyEvent::VERBOSE; +$AnyEvent::VERBOSE = 9; + +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 ($ORIG_VERBOSE); + + $COLLECT->slaves ($FILTER); + $COLLECT->title ('$AnyEvent::Log::COLLECT'); + + _reassess; } +# override AE::log/logger +*AnyEvent::log = *AE::log = \&log; +*AnyEvent::logger = *AE::logger = \&logger; + +# convert AnyEvent loggers to AnyEvent::Log loggers +$_->[0] = ctx $_->[0] # convert "pkg" to "ctx" + for values %LOGGER; + +# 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, %$parents, &$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]) @@ -375,15 +731,30 @@ $_[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 fot the given levels and disables it for all others. +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. Specifying a level of C<0> or C disables all logging for this -level. +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. @@ -398,11 +769,40 @@ Disables logging for the given levels, leaving all others unchanged. +=item $ctx->cap ($level) + +Caps the maximum priority to the given level, for all messages logged +to, or passing through, this context. That is, while this doesn't affect +whether a message is logged or passed on, the maximum priority of messages +will be limited to the specified level - messages with a higher priority +will be set to the specified priority. + +Another way to view this is that C<< ->level >> filters out messages with +a too low priority, while C<< ->cap >> modifies messages with a too high +priority. + +This is useful when different log targets have different interpretations +of priority. For example, for a specific command line program, a wrong +command line switch might well result in a C log message, while the +same message, logged to syslog, is likely I fatal to the system or +syslog facility as a whole, but more likely a mere C. + +This can be modeled by having a stderr logger that logs messages "as-is" +and a syslog logger that logs messages with a level cap of, say, C, +or, for truly system-critical components, actually C. + =cut sub _lvl_lst { - map { $_ > 0 && $_ <= 9 ? $_+0 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" } - @_ + map { + $_ > 0 && $_ <= 9 ? $_+0 + : $_ eq "all" ? (1 .. 9) + : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" + } @_ +} + +sub _lvl { + $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1] } our $NOP_CB = sub { 0 }; @@ -417,8 +817,7 @@ sub level { my $ctx = shift; - my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[0]; - $ctx->[1] = ((1 << $lvl) - 1) << 1; + $ctx->[1] = ((1 << &_lvl) - 1) << 1; AnyEvent::Log::_reassess; } @@ -436,20 +835,41 @@ AnyEvent::Log::_reassess; } +sub cap { + my $ctx = shift; + $ctx->[5] = &_lvl; +} + +=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 parents to this context. It is not an error +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 parents from this context - it's not an error to attempt +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 { @@ -466,6 +886,21 @@ 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 @@ -477,22 +912,52 @@ 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 -parent context. When in doubt, return C<0> from your logging callback. +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 }); -=item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message)) +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. -Replaces the fornatting callback on the cobntext (C restores the +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. +logging context (object, not title), 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 about the +logger then you should walk up the call stack until you are no longer +inside the C package. + +To implement your own logging callback, you might find the +C and C +functions useful. + +Example: format the message just as AnyEvent::Log would, by letting +AnyEvent::Log do the work. This is a good basis to design a formatting +callback that only changes minor aspects of the formatting. + + $ctx->fmt_cb (sub { + my ($time, $ctx, $lvl, $msg) = @_; + + AnyEvent::Log::default_format $time, $ctx, $lvl, $msg + }); Example: format just the raw message, with numeric log level in angle brackets. @@ -504,7 +969,7 @@ }); Example: return an array reference with just the log values, and use -C to store the emssage in a database. +C to store the message in a database. $ctx->fmt_cb (sub { \@_ }); $ctx->log_cb (sub { @@ -519,12 +984,42 @@ 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. The +function might return before the log file has been opened or created. + +=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 ([$facility]) + +Logs all messages via L, mapping C to C and +all the others in the obvious way. If specified, then the C<$facility> is +used as the facility (C, C, C and so on). The default +facility is C. + +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 || $default_log_cb; + $ctx->[3] = $cb; } sub fmt_cb { @@ -533,10 +1028,152 @@ $ctx->[4] = $cb; } +sub log_to_warn { + my ($ctx, $path) = @_; + + $ctx->log_cb (sub { + warn shift; + 0 + }); +} + +# this function is a good example of why threads are a must, +# simply for priority inversion. +sub _log_to_disk { + # eval'uating this at runtime saves 220kb rss - perl has become + # an insane memory waster. + eval q{ # poor man's autoloading {} + sub _log_to_disk { + my ($ctx, $path, $keepopen) = @_; + + my $fh; + my @queue; + my $delay; + my $disable; + + use AnyEvent::IO (); + + my $kick = sub { + undef $delay; + return unless @queue; + $delay = 1; + + # we pass $kick to $kick, so $kick itself doesn't keep a reference to $kick. + my $kick = shift; + + # write one or more messages + my $write = sub { + # we write as many messages as have been queued + my $data = join "", @queue; + @queue = (); + + AnyEvent::IO::aio_write $fh, $data, sub { + $disable = 1; + @_ + ? ($_[0] == length $data or AE::log 4 => "unable to write to logfile '$path': short write") + : AE::log 4 => "unable to write to logfile '$path': $!"; + undef $disable; + + if ($keepopen) { + $kick->($kick); + } else { + AnyEvent::IO::aio_close ($fh, sub { + undef $fh; + $kick->($kick); + }); + } + }; + }; + + if ($fh) { + $write->(); + } else { + AnyEvent::IO::aio_open + $path, + AnyEvent::IO::O_CREAT | AnyEvent::IO::O_WRONLY | AnyEvent::IO::O_APPEND, + 0666, + sub { + $fh = shift + or do { + $disable = 1; + AE::log 4 => "unable to open logfile '$path': $!"; + undef $disable; + return; + }; + + $write->(); + } + ; + } + }; + + $ctx->log_cb (sub { + return if $disable; + push @queue, shift; + $kick->($kick) unless $delay; + 0 + }); + + $kick->($kick) if $keepopen; # initial open + }; + }; + die if $@; + &_log_to_disk +} + +sub log_to_file { + my ($ctx, $path) = @_; + + _log_to_disk $ctx, $path, 1; +} + +sub log_to_path { + my ($ctx, $path) = @_; + + _log_to_disk $ctx, $path, 0; +} + +sub log_to_syslog { + 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 = $_[0][0] < 9 ? $_[0][0] : 8; + + Sys::Syslog::syslog ("$facility|" . ($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. +Example: log a message in the context of another package. + + (AnyEvent::Log::ctx "Other::Package")->log (warn => "heely bo"); + =item $logger = $ctx->logger ($level[, \$enabled]) Same as C, but uses the given context as log @@ -547,13 +1184,335 @@ *log = \&AnyEvent::Log::_log; *logger = \&AnyEvent::Log::_logger; -1; +=back + +=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 + +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. + +This makes it possible to create new log contexts that can be refered to +multiple times by name within the same log specification. + +=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 + +Configures 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 CI + +Caps logging messages entering this context at the given level, i.e. +reduces the priority of messages with higher priority than this level. The +default is C<0> (or C), meaning the priority will not be touched. + +=item C<0> or C + +Sets the logging level of the context to 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> or 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 + +Attaches the named context as slave to the context. + +=item C<+> + +A lone 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, 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} ||= do { my $ctx = ctx undef; $ctx->[0] = $_[0]; $ctx }) + : $_[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 (/^cap=(.+)/ ) { $ctx->cap ("$1"); + } 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"; + } +} + +=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 Additionally log all messages with C and higher priority to +C, but cap at C. + +This logs all messages to the default log target, but also logs messages +with priority C or higher (and not filtered otherwise) to syslog +facility C. Messages with priority higher than C will be +logged with level C. + + $AnyEvent::Log::LOG->attach ( + new AnyEvent::Log::Ctx + level => "warn", + cap => "error", + syslog => "user", + ); + + PERL_ANYEVENT_LOG=log=+%syslog:%syslog=warn,cap=error,syslog + +=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 ASYNCHRONOUS DISK I/O + +This module uses L to actually write log messages (in +C and C), so it doesn't block your program when +the disk is busy and a non-blocking L backend is available. + =head1 AUTHOR Marc Lehmann - http://home.schmorp.de/ + http://anyevent.schmorp.de =cut + +1 +