view release on metacpan or  search on metacpan

lib/AnyEvent/Log.pm  view on Meta::CPAN

   $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
      {
         # 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;

   fatal_exit if $level <= 1;

   $success
}

sub log($$;@) {
   _log
      $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
      @_;
}

=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 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";

   $debug_log->("debug here");
   $debug_log->("%06d emails processed", 12345);
   $debug_log->(sub { $obj->as_string });

The idea behind this function is to decide whether to log before actually
logging - when the C<logger> function is called once, but the returned
logger callback often, then this can be a tremendous speed win.

Despite this speed advantage, changes in logging configuration will
still be reflected by the logger callback, even if configuration changes
I<after> it was created.

To further speed up logging, you can bind a scalar variable to the logger,
which contains true if the logger should be called or not - if it is
false, calling the logger can be safely skipped. This variable will be
updated as long as C<$logger> is alive.

Full example:

   # near the init section
   use AnyEvent::Log;

   my $debug_log = AnyEvent:Log::logger debug => \my $debug;

   # and later in your program
   $debug_log->("yo, stuff here") if $debug;

   $debug and $debug_log->("123");

=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 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 {
         _log $ctx, $level, $die;

         1
      };
   }
}

sub _logger {
   my ($ctx, $level, $renabled) = @_;

   $$renabled = 1;

   my $logger = [$ctx, $level, $renabled];

   $LOGGER{$logger+0} = $logger;

   _reassess $logger+0;

   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

      _log $ctx, $level, @_
         if $$renabled;
   }
}

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.

=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<AnyEvent::Log> 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<fatal> log
message. It must not return.

The default implementation simply calls C<exit 1>.

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 LOGGING CONTEXTS

This module associates every log message with a so-called I<logging
context>, based on the package of the caller. Every perl package has its
own logging context.

lib/AnyEvent/Log.pm  view on Meta::CPAN

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<warn>, 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<warn>.

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 package 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<AE::log> call
would use).

If C<undef> 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

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;