lib/AnyEvent/Log.pm

=head1 NAME

AnyEvent::Log - simple logging "framework"

=head1 SYNOPSIS

   # simple use
   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!";

   # complex use
   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;

   #TODO: config
   #TODO: ctx () becomes caller[0]...

=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
AnyEvent - AnyEvent simply creates logging messages internally, and this
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<PERL_ANYEVENT_VERBOSE> to a higher number
before starting your program, or change the logging level at runtime wiht
something like:

   use AnyEvent;
   (AnyEvent::Log::ctx "")->level ("info");

=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
callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is
loaded.

=over 4

=cut

package AnyEvent::Log;

use Carp ();
use POSIX ();

use AnyEvent (); BEGIN { AnyEvent::common_sense }
use AnyEvent::Util ();

our ($now_int, $now_str1, $now_str2);

# Format Time, not public - yet?
sub ft($) {
   my $i = int $_[0];
   my $f = sprintf "%06d", 1e6 * ($_[0] - $i);

   ($now_int, $now_str1, $now_str2) = ($i, split /\x01/, POSIX::strftime "%Y-%m-%d %H:%M:%S.\x01 %z", localtime $i)
      if $now_int != $i;

   "$now_str1$f$now_str2"
}

our %CTX; # all logging contexts

my $default_log_cb = sub { 0 };

# creates a default package context object for the given package
sub _pkg_ctx($) {
   my $ctx = bless [$_[0], 0, {}, $default_log_cb], "AnyEvent::Log::Ctx";

   # link "parent" package
   my $pkg = $_[0] =~ /^(.+)::/ ? $1 : "";

   $pkg = $CTX{$pkg} ||= &_pkg_ctx ($pkg);
   $ctx->[2]{$pkg+0} = $pkg;

   $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<fatal> (1),
C<alert> (2), C<critical> (3), C<error> (4), C<warn> (5), C<note> (6),
C<info> (7), C<debug> (8), C<trace> (9).

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.

The C<$msg> should not end with C<\n>, but may if that is convenient for
you. Also, multiline messages are handled properly.

Last not least, C<$msg> might be a code reference, in which case it is
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.

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.

Also, if you otpionally 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<logger>, below).

Example: log something at error level.

   AE::log error => "something";

Example: use printf-formatting.

   AE::log info => "%5d %-10.10s %s", $index, $category, $msg;

Example: only generate a costly dump when the message is actually being logged.

   AE::log debug => sub { require Data::Dump; Data::Dump::dump \%cache };

=cut

# also allow syslog equivalent names
our %STR2LEVEL = (
   fatal    => 1, emerg    => 1,
   alert    => 2,
   critical => 3, crit     => 3,
   error    => 4, err      => 4,
   warn     => 5, warning  => 5,
   note     => 6, notice   => 6,
   info     => 7,
   debug    => 8,
   trace    => 9,
);

sub now () { time }
AnyEvent::post_detect {
   *now = \&AE::now;
};

our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);

# time, ctx, level, msg
sub _format($$$$) {
   my $pfx = ft $_[0];

   join "",
      map "$pfx $_\n",
         split /\n/,
            sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]
}

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

   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;

         $ctx->[3]($str)
            and next;
      }

      # not consume - push parent contexts
      push @ctx, values %{ $ctx->[2] };
   } while $ctx = pop @ctx;

   exit 1 if $level <= 1;
}

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

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 {
   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
      # sure that the logging decision is correct :)

      $$renabled = !eval {
         local $SIG{__DIE__};

         _log $ctx, $level, sub { die };

         1
      };

      $$renabled = 1; # TODO
   }
}

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

   $renabled ||= \my $enabled;

   $$renabled = 1;

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

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

   _reassess $logger+0;

   my $guard = AnyEvent::Util::guard {
      # "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],
      @_
}

#TODO

=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.

A logging context has two major responsibilities: logging the message and
propagating the message to other contexts.

For logging, the context stores a set of logging levels that it
potentially wishes to log, a formatting callback that takes the timestamp,
context, level and string emssage 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<AnyEvent::Log> whether it has consumed
the message, or whether it should be propagated.

For propagation, a context can have any number of attached I<parent
contexts>. They will be ignored if the logging callback consumes the
message, but in all other cases, the log message will be passed to all
parent contexts attached to a context.

=head2 DEFAULTS

By default, all logging contexts have an empty set of log levels, a
disabled logging callback and the default formatting callback.

Package contexts have the package name as logging title by default.

They have exactly one parent - the context of the "parent" package. The
parent package is simply defined to be the package name without the last
component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>,
and C<AnyEvent> becomes the empty string.

Since perl packages form only an approximate hierarchy, this parent
context can of course be removed.

All other (anonymous) contexts have no parents and an empty title by
default.

When the module is first loaded, it configures the root context (the one
with the empty string) to simply dump all log messages to C<STDERR>,
and sets it's log level set to all levels up to the one specified by
C<$ENV{PERL_ANYEVENT_VERBOSE}>.

The effetc of all this is that log messages, by default, wander up to the
root context and will be logged to STDERR if their log level is less than
or equal to C<$ENV{PERL_ANYEVENT_VERBOSE}>.

=head2 CREATING/FINDING A CONTEXT

=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<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, 0, undef, $default_log_cb], "AnyEvent::Log::Ctx"
}

# create default root context
{
   my $root = ctx undef;
   $root->[0] = "";
   $root->title ("default");
   $root->level ($AnyEvent::VERBOSE); undef $AnyEvent::VERBOSE;
   $root->log_cb (sub {
      print STDERR shift;
      0
   });
   $CTX{""} = $root;
}

=back

=cut

package AnyEvent::Log::Ctx;

#       0       1          2        3        4
# [$title, $level, %$parents, &$logcb, &$fmtcb]

=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 wiht the log context.

The most common method to use is probably C<< $ctx->level ($level) >>,
which configures the specified and any higher priority levels.

=over 4

=item $ctx->levels ($level[, $level...)

Enables logging fot 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<off> 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 : $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])[0];
   $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 PARENT CONTEXTS

The following methods attach and detach another logging context to a
logging context.

Log messages are propagated to all parent 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
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
to remove a context that hasn't been added.

A context can be specified either as package name or as a context object.

=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 $_ } @_;
}

=back

=head3 MESSAGE LOGGING

The following methods configure how the logging context actually does
the logging (which consists of foratting the message and printing it or
whatever it wants to do with it) and also allows you to log messages
directly to a context, without going via your package context.

=over 4

=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).

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.

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))

Replaces the fornatting callback on the cobntext (C<undef> 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.

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<PApp::SQL::sql_exec> 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
   });

=cut

sub log_cb {
   my ($ctx, $cb) = @_;

   $ctx->[3] = $cb || $default_log_cb;
}

sub fmt_cb {
   my ($ctx, $cb) = @_;

   $ctx->[4] = $cb;
}

=item $ctx->log ($level, $msg[, @params])

Same as C<AnyEvent::Log::log>, but uses the given context as log context.

=item $logger = $ctx->logger ($level[, \$enabled])

Same as C<AnyEvent::Log::logger>, but uses the given context as log
context.

=cut

*log    = \&AnyEvent::Log::_log;
*logger = \&AnyEvent::Log::_logger;

1;

=back

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut
Revision:	1.9
Committed:	Fri Aug 19 19:59:53 2011 UTC (12 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.8:	+102 -13 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			AnyEvent::Log - simple logging "framework"
4
5			=head1 SYNOPSIS
6
7	root	1.8	# simple use
8			use AnyEvent;
9
10			AE::log debug => "hit my knee";
11			AE::log warn => "it's a bit too hot";
12			AE::log error => "the flag was false!";
13			AE::log fatal => "the bit toggled! run!";
14
15			# complex use
16	root	1.1	use AnyEvent::Log;
17
18	root	1.8	my $tracer = AnyEvent::Log::logger trace => \$my $trace;
19
20			$tracer->("i am here") if $trace;
21			$tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
22
23			#TODO: config
24			#TODO: ctx () becomes caller[0]...
25
26	root	1.1	=head1 DESCRIPTION
27
28	root	1.2	This module implements a relatively simple "logging framework". It doesn't
29			attempt to be "the" logging solution or even "a" logging solution for
30			AnyEvent - AnyEvent simply creates logging messages internally, and this
31			module more or less exposes the mechanism, with some extra spiff to allow
32			using it from other modules as well.
33
34	root	1.5	Remember that the default verbosity level is C<0>, so nothing will be
35			logged, ever, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
36	root	1.9	before starting your program, or change the logging level at runtime wiht
37			something like:
38	root	1.2
39	root	1.9	use AnyEvent;
40			(AnyEvent::Log::ctx "")->level ("info");
41	root	1.2
42	root	1.9	=head1 LOGGING FUNCTIONS
43	root	1.2
44			These functions allow you to log messages. They always use the caller's
45	root	1.7	package as a "logging module/source". Also, the main logging function is
46			callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is
47			loaded.
48	root	1.1
49			=over 4
50
51			=cut
52
53			package AnyEvent::Log;
54
55	root	1.2	use Carp ();
56	root	1.1	use POSIX ();
57
58			use AnyEvent (); BEGIN { AnyEvent::common_sense }
59	root	1.3	use AnyEvent::Util ();
60	root	1.1
61	root	1.2	our ($now_int, $now_str1, $now_str2);
62
63			# Format Time, not public - yet?
64			sub ft($) {
65			my $i = int $_[0];
66			my $f = sprintf "%06d", 1e6 * ($_[0] - $i);
67
68			($now_int, $now_str1, $now_str2) = ($i, split /\x01/, POSIX::strftime "%Y-%m-%d %H:%M:%S.\x01 %z", localtime $i)
69			if $now_int != $i;
70
71			"$now_str1$f$now_str2"
72			}
73
74	root	1.5	our %CTX; # all logging contexts
75	root	1.3
76	root	1.8	my $default_log_cb = sub { 0 };
77
78			# creates a default package context object for the given package
79			sub _pkg_ctx($) {
80			my $ctx = bless [$_[0], 0, {}, $default_log_cb], "AnyEvent::Log::Ctx";
81
82			# link "parent" package
83			my $pkg = $_[0] =~ /^(.+)::/ ? $1 : "";
84
85			$pkg = $CTX{$pkg} \|\|= &_pkg_ctx ($pkg);
86			$ctx->[2]{$pkg+0} = $pkg;
87
88			$ctx
89			}
90
91	root	1.2	=item AnyEvent::Log::log $level, $msg[, @args]
92
93			Requests logging of the given C<$msg> with the given log level (1..9).
94			You can also use the following strings as log level: C<fatal> (1),
95			C<alert> (2), C<critical> (3), C<error> (4), C<warn> (5), C<note> (6),
96			C<info> (7), C<debug> (8), C<trace> (9).
97
98			For C<fatal> log levels, the program will abort.
99
100			If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the
101			C<$msg> is interpreted as an sprintf format string.
102
103			The C<$msg> should not end with C<\n>, but may if that is convenient for
104			you. Also, multiline messages are handled properly.
105
106	root	1.3	Last not least, C<$msg> might be a code reference, in which case it is
107			supposed to return the message. It will be called only then the message
108			actually gets logged, which is useful if it is costly to create the
109			message in the first place.
110	root	1.2
111			Whether the given message will be logged depends on the maximum log level
112			and the caller's package.
113
114			Note that you can (and should) call this function as C<AnyEvent::log> or
115	root	1.8	C<AE::log>, without C<use>-ing this module if possible (i.e. you don't
116			need any additional functionality), as those functions will load the
117			logging module on demand only. They are also much shorter to write.
118
119			Also, if you otpionally generate a lot of debug messages (such as when
120			tracing some code), you should look into using a logger callback and a
121			boolean enabler (see C<logger>, below).
122	root	1.2
123	root	1.3	Example: log something at error level.
124
125			AE::log error => "something";
126
127			Example: use printf-formatting.
128
129			AE::log info => "%5d %-10.10s %s", $index, $category, $msg;
130
131			Example: only generate a costly dump when the message is actually being logged.
132
133			AE::log debug => sub { require Data::Dump; Data::Dump::dump \%cache };
134
135	root	1.2	=cut
136
137			# also allow syslog equivalent names
138			our %STR2LEVEL = (
139			fatal => 1, emerg => 1,
140			alert => 2,
141			critical => 3, crit => 3,
142			error => 4, err => 4,
143			warn => 5, warning => 5,
144			note => 6, notice => 6,
145			info => 7,
146			debug => 8,
147			trace => 9,
148			);
149
150	root	1.4	sub now () { time }
151			AnyEvent::post_detect {
152			*now = \&AE::now;
153			};
154
155	root	1.2	our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
156
157	root	1.8	# time, ctx, level, msg
158			sub _format($$$$) {
159			my $pfx = ft $_[0];
160
161			join "",
162			map "$pfx $_\n",
163			split /\n/,
164			sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]
165			}
166
167	root	1.3	sub _log {
168	root	1.8	my ($ctx, $level, $format, @args) = @_;
169	root	1.2
170	root	1.8	$level = $level > 0 && $level <= 9 ? $level+0 : $STR2LEVEL{$level} \|\| Carp::croak "$level: not a valid logging level, caught";
171	root	1.2
172	root	1.8	my $mask = 1 << $level;
173			my $now = AE::now;
174	root	1.2
175	root	1.8	my (@ctx, $did_format, $fmt);
176	root	1.4
177	root	1.8	do {
178			if ($ctx->[1] & $mask) {
179			# logging target found
180
181			# get raw message
182			unless ($did_format) {
183			$format = $format->() if ref $format;
184			$format = sprintf $format, @args if @args;
185			$format =~ s/\n$//;
186			$did_format = 1;
187			};
188
189			# format msg
190			my $str = $ctx->[4]
191			? $ctx->[4]($now, $_[0], $level, $format)
192			: $fmt \|\|= _format $now, $_[0], $level, $format;
193
194			$ctx->[3]($str)
195			and next;
196			}
197
198			# not consume - push parent contexts
199			push @ctx, values %{ $ctx->[2] };
200			} while $ctx = pop @ctx;
201	root	1.2
202			exit 1 if $level <= 1;
203			}
204
205	root	1.3	sub log($$;@) {
206	root	1.8	_log
207			$CTX{ (caller)[0] } \|\|= _pkg_ctx +(caller)[0],
208			@_;
209	root	1.3	}
210
211	root	1.2	AnyEvent::log = AE::log = \&log;
212
213	root	1.3	=item $logger = AnyEvent::Log::logger $level[, \$enabled]
214
215			Creates a code reference that, when called, acts as if the
216			C<AnyEvent::Log::log> function was called at this point with the givne
217			level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
218			the C<AnyEvent::Log::log> function:
219
220			my $debug_log = AnyEvent::Log::logger "debug";
221
222			$debug_log->("debug here");
223			$debug_log->("%06d emails processed", 12345);
224			$debug_log->(sub { $obj->as_string });
225
226			The idea behind this function is to decide whether to log before actually
227			logging - when the C<logger> function is called once, but the returned
228			logger callback often, then this can be a tremendous speed win.
229
230			Despite this speed advantage, changes in logging configuration will
231			still be reflected by the logger callback, even if configuration changes
232			I<after> it was created.
233
234			To further speed up logging, you can bind a scalar variable to the logger,
235			which contains true if the logger should be called or not - if it is
236			false, calling the logger can be safely skipped. This variable will be
237			updated as long as C<$logger> is alive.
238
239			Full example:
240
241			# near the init section
242			use AnyEvent::Log;
243
244			my $debug_log = AnyEvent:Log::logger debug => \my $debug;
245
246			# and later in your program
247			$debug_log->("yo, stuff here") if $debug;
248
249			$debug and $debug_log->("123");
250
251			Note: currently the enabled var is always true - that will be fixed in a
252			future version :)
253
254			=cut
255
256			our %LOGGER;
257
258			# re-assess logging status for all loggers
259			sub _reassess {
260			for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
261	root	1.8	my ($ctx, $level, $renabled) = @$_;
262	root	1.3
263			# to detetc whether a message would be logged, we # actually
264			# try to log one and die. this isn't # fast, but we can be
265			# sure that the logging decision is correct :)
266
267			$$renabled = !eval {
268			local $SIG{__DIE__};
269
270	root	1.8	_log $ctx, $level, sub { die };
271	root	1.3
272			1
273			};
274
275			$$renabled = 1; # TODO
276			}
277			}
278
279	root	1.8	sub _logger($;$) {
280			my ($ctx, $level, $renabled) = @_;
281	root	1.3
282			$renabled \|\|= \my $enabled;
283
284			$$renabled = 1;
285
286	root	1.8	my $logger = [$ctx, $level, $renabled];
287	root	1.3
288			$LOGGER{$logger+0} = $logger;
289
290			_reassess $logger+0;
291
292			my $guard = AnyEvent::Util::guard {
293			# "clean up"
294			delete $LOGGER{$logger+0};
295			};
296
297			sub {
298			$guard if 0; # keep guard alive, but don't cause runtime overhead
299
300	root	1.8	_log $ctx, $level, @_
301	root	1.3	if $$renabled;
302			}
303			}
304
305	root	1.8	sub logger($;$) {
306			_logger
307			$CTX{ (caller)[0] } \|\|= _pkg_ctx +(caller)[0],
308			@_
309			}
310
311	root	1.2	#TODO
312
313			=back
314
315	root	1.9	=head1 LOGGING CONTEXTS
316	root	1.2
317	root	1.9	This module associates every log message with a so-called I<logging
318			context>, based on the package of the caller. Every perl package has its
319			own logging context.
320	root	1.8
321	root	1.9	A logging context has two major responsibilities: logging the message and
322			propagating the message to other contexts.
323
324			For logging, the context stores a set of logging levels that it
325			potentially wishes to log, a formatting callback that takes the timestamp,
326			context, level and string emssage and formats it in the way it should be
327			logged, and a logging callback, which is responsible for actually logging
328			the formatted message and telling C<AnyEvent::Log> whether it has consumed
329			the message, or whether it should be propagated.
330
331			For propagation, a context can have any number of attached I<parent
332			contexts>. They will be ignored if the logging callback consumes the
333			message, but in all other cases, the log message will be passed to all
334			parent contexts attached to a context.
335
336			=head2 DEFAULTS
337
338			By default, all logging contexts have an empty set of log levels, a
339			disabled logging callback and the default formatting callback.
340
341			Package contexts have the package name as logging title by default.
342
343			They have exactly one parent - the context of the "parent" package. The
344			parent package is simply defined to be the package name without the last
345			component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>,
346			and C<AnyEvent> becomes the empty string.
347
348			Since perl packages form only an approximate hierarchy, this parent
349			context can of course be removed.
350
351			All other (anonymous) contexts have no parents and an empty title by
352			default.
353
354			When the module is first loaded, it configures the root context (the one
355			with the empty string) to simply dump all log messages to C<STDERR>,
356			and sets it's log level set to all levels up to the one specified by
357			C<$ENV{PERL_ANYEVENT_VERBOSE}>.
358
359			The effetc of all this is that log messages, by default, wander up to the
360			root context and will be logged to STDERR if their log level is less than
361			or equal to C<$ENV{PERL_ANYEVENT_VERBOSE}>.
362
363			=head2 CREATING/FINDING A CONTEXT
364	root	1.2
365			=over 4
366
367	root	1.8	=item $ctx = AnyEvent::Log::ctx [$pkg]
368
369	root	1.9	This function creates or returns a logging context (which is an object).
370	root	1.8
371	root	1.9	If a package name is given, then the context for that packlage is
372			returned. If it is called without any arguments, then the context for the
373			callers package is returned (i.e. the same context as a C<AE::log> call
374			would use).
375	root	1.8
376			If C<undef> is given, then it creates a new anonymous context that is not
377			tied to any package and is destroyed when no longer referenced.
378
379			=cut
380
381			sub ctx(;$) {
382			my $pkg = @_ ? shift : (caller)[0];
383
384			ref $pkg
385			? $pkg
386			: defined $pkg
387			? $CTX{$pkg} \|\|= AnyEvent::Log::_pkg_ctx $pkg
388			: bless [undef, 0, undef, $default_log_cb], "AnyEvent::Log::Ctx"
389			}
390
391			# create default root context
392			{
393			my $root = ctx undef;
394			$root->[0] = "";
395			$root->title ("default");
396	root	1.9	$root->level ($AnyEvent::VERBOSE); undef $AnyEvent::VERBOSE;
397	root	1.8	$root->log_cb (sub {
398			print STDERR shift;
399			0
400			});
401			$CTX{""} = $root;
402			}
403
404	root	1.9	=back
405
406			=cut
407
408	root	1.8	package AnyEvent::Log::Ctx;
409
410			# 0 1 2 3 4
411			# [$title, $level, %$parents, &$logcb, &$fmtcb]
412
413	root	1.9	=head2 CONFIGURING A LOG CONTEXT
414
415			The following methods can be used to configure the logging context.
416
417			=over 4
418
419	root	1.8	=item $ctx->title ([$new_title])
420
421			Returns the title of the logging context - this is the package name, for
422			package contexts, and a user defined string for all others.
423
424			If C<$new_title> is given, then it replaces the package name or title.
425
426			=cut
427
428			sub title {
429			$_[0][0] = $_[1] if @_ > 1;
430			$_[0][0]
431			}
432
433	root	1.9	=back
434
435			=head3 LOGGING LEVELS
436
437			The following methods deal with the logging level set associated wiht the log context.
438
439			The most common method to use is probably C<< $ctx->level ($level) >>,
440			which configures the specified and any higher priority levels.
441
442			=over 4
443
444	root	1.8	=item $ctx->levels ($level[, $level...)
445
446			Enables logging fot the given levels and disables it for all others.
447
448			=item $ctx->level ($level)
449
450			Enables logging for the given level and all lower level (higher priority)
451			ones. Specifying a level of C<0> or C<off> disables all logging for this
452			level.
453
454			Example: log warnings, errors and higher priority messages.
455
456			$ctx->level ("warn");
457			$ctx->level (5); # same thing, just numeric
458
459			=item $ctx->enable ($level[, $level...])
460
461			Enables logging for the given levels, leaving all others unchanged.
462	root	1.5
463	root	1.8	=item $ctx->disable ($level[, $level...])
464
465			Disables logging for the given levels, leaving all others unchanged.
466
467			=cut
468
469			sub _lvl_lst {
470			map { $_ > 0 && $_ <= 9 ? $_+0 : $STR2LEVEL{$_} \|\| Carp::croak "$_: not a valid logging level, caught" }
471			@_
472			}
473
474			our $NOP_CB = sub { 0 };
475
476			sub levels {
477			my $ctx = shift;
478			$ctx->[1] = 0;
479			$ctx->[1] \|= 1 << $_
480			for &_lvl_lst;
481			AnyEvent::Log::_reassess;
482			}
483
484			sub level {
485			my $ctx = shift;
486			my $lvl = $_[0] =~ /^(?:0\|off\|none)$/ ? 0 : (_lvl_lst $_[0])[0];
487			$ctx->[1] = ((1 << $lvl) - 1) << 1;
488			AnyEvent::Log::_reassess;
489			}
490
491			sub enable {
492			my $ctx = shift;
493			$ctx->[1] \|= 1 << $_
494			for &_lvl_lst;
495			AnyEvent::Log::_reassess;
496			}
497
498			sub disable {
499			my $ctx = shift;
500			$ctx->[1] &= ~(1 << $_)
501			for &_lvl_lst;
502			AnyEvent::Log::_reassess;
503			}
504
505	root	1.9	=back
506
507			=head3 PARENT CONTEXTS
508
509			The following methods attach and detach another logging context to a
510			logging context.
511
512			Log messages are propagated to all parent contexts, unless the logging
513			callback consumes the message.
514
515			=over 4
516
517	root	1.8	=item $ctx->attach ($ctx2[, $ctx3...])
518
519			Attaches the given contexts as parents to this context. It is not an error
520			to add a context twice (the second add will be ignored).
521
522			A context can be specified either as package name or as a context object.
523
524			=item $ctx->detach ($ctx2[, $ctx3...])
525
526			Removes the given parents from this context - it's not an error to attempt
527			to remove a context that hasn't been added.
528
529			A context can be specified either as package name or as a context object.
530	root	1.5
531	root	1.2	=cut
532
533	root	1.8	sub attach {
534			my $ctx = shift;
535
536			$ctx->[2]{$_+0} = $_
537			for map { AnyEvent::Log::ctx $_ } @_;
538			}
539
540			sub detach {
541			my $ctx = shift;
542
543			delete $ctx->[2]{$_+0}
544			for map { AnyEvent::Log::ctx $_ } @_;
545			}
546
547	root	1.9	=back
548
549			=head3 MESSAGE LOGGING
550
551			The following methods configure how the logging context actually does
552			the logging (which consists of foratting the message and printing it or
553			whatever it wants to do with it) and also allows you to log messages
554			directly to a context, without going via your package context.
555
556			=over 4
557
558	root	1.8	=item $ctx->log_cb ($cb->($str))
559	root	1.5
560	root	1.8	Replaces the logging callback on the context (C<undef> disables the
561			logging callback).
562	root	1.5
563	root	1.8	The logging callback is responsible for handling formatted log messages
564			(see C<fmt_cb> below) - normally simple text strings that end with a
565			newline (and are possibly multiline themselves).
566
567			It also has to return true iff it has consumed the log message, and false
568			if it hasn't. Consuming a message means that it will not be sent to any
569			parent context. When in doubt, return C<0> from your logging callback.
570
571			Example: a very simple logging callback, simply dump the message to STDOUT
572			and do not consume it.
573
574			$ctx->log_cb (sub { print STDERR shift; 0 });
575
576			=item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message))
577
578			Replaces the fornatting callback on the cobntext (C<undef> restores the
579			default formatter).
580
581			The callback is passed the (possibly fractional) timestamp, the original
582			logging context, the (numeric) logging level and the raw message string and needs to
583			return a formatted log message. In most cases this will be a string, but
584			it could just as well be an array reference that just stores the values.
585
586			Example: format just the raw message, with numeric log level in angle
587			brackets.
588
589			$ctx->fmt_cb (sub {
590			my ($time, $ctx, $lvl, $msg) = @_;
591
592			"<$lvl>$msg\n"
593			});
594
595			Example: return an array reference with just the log values, and use
596			C<PApp::SQL::sql_exec> to store the emssage in a database.
597
598			$ctx->fmt_cb (sub { \@_ });
599			$ctx->log_cb (sub {
600			my ($msg) = @_;
601
602			sql_exec "insert into log (when, subsys, prio, msg) values (?, ?, ?, ?)",
603			$msg->[0] + 0,
604			"$msg->[1]",
605			$msg->[2] + 0,
606			"$msg->[3]";
607
608			0
609			});
610
611			=cut
612
613			sub log_cb {
614			my ($ctx, $cb) = @_;
615	root	1.6
616	root	1.8	$ctx->[3] = $cb \|\| $default_log_cb;
617	root	1.6	}
618	root	1.5
619	root	1.8	sub fmt_cb {
620			my ($ctx, $cb) = @_;
621	root	1.6
622	root	1.8	$ctx->[4] = $cb;
623	root	1.5	}
624
625	root	1.8	=item $ctx->log ($level, $msg[, @params])
626
627			Same as C<AnyEvent::Log::log>, but uses the given context as log context.
628
629			=item $logger = $ctx->logger ($level[, \$enabled])
630
631			Same as C<AnyEvent::Log::logger>, but uses the given context as log
632			context.
633
634			=cut
635
636			*log = \&AnyEvent::Log::_log;
637			*logger = \&AnyEvent::Log::_logger;
638
639	root	1.1	1;
640
641			=back
642
643			=head1 AUTHOR
644
645			Marc Lehmann <schmorp@schmorp.de>
646			http://home.schmorp.de/
647
648			=cut