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.#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<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 CONFIGURATION FUNCTIONALITY

None, yet, except for C<PERL_ANYEVENT_VERBOSE>, described in the L<AnyEvent> manpage.

#TODO: wahst a context
#TODO

=over 4

=item $ctx = AnyEvent::Log::ctx [$pkg]

Returns a I<config> object for the given package name.

If no package name is given, returns the context for the current perl
package (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);
   $root->log_cb (sub {
      print STDERR shift;
      0
   });
   $CTX{""} = $root;
}

package AnyEvent::Log::Ctx;

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

=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]
}

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

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

=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.8
Committed:	Fri Aug 19 19:20:36 2011 UTC (12 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.7:	+309 -51 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			before starting your program.#TODO
37	root	1.2
38			Possible future extensions are to allow custom log targets (where the
39			level is an object), log filtering based on package, formatting, aliasing
40			or package groups.
41
42			=head1 LOG FUNCTIONS
43
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			=head1 CONFIGURATION FUNCTIONALITY
316
317			None, yet, except for C<PERL_ANYEVENT_VERBOSE>, described in the L<AnyEvent> manpage.
318	root	1.8
319			#TODO: wahst a context
320	root	1.6	#TODO
321	root	1.2
322			=over 4
323
324	root	1.8	=item $ctx = AnyEvent::Log::ctx [$pkg]
325
326			Returns a I<config> object for the given package name.
327
328			If no package name is given, returns the context for the current perl
329			package (i.e. the same context as a C<AE::log> call would use).
330
331			If C<undef> is given, then it creates a new anonymous context that is not
332			tied to any package and is destroyed when no longer referenced.
333
334			=cut
335
336			sub ctx(;$) {
337			my $pkg = @_ ? shift : (caller)[0];
338
339			ref $pkg
340			? $pkg
341			: defined $pkg
342			? $CTX{$pkg} \|\|= AnyEvent::Log::_pkg_ctx $pkg
343			: bless [undef, 0, undef, $default_log_cb], "AnyEvent::Log::Ctx"
344			}
345
346			# create default root context
347			{
348			my $root = ctx undef;
349			$root->[0] = "";
350			$root->title ("default");
351			$root->level ($AnyEvent::VERBOSE);
352			$root->log_cb (sub {
353			print STDERR shift;
354			0
355			});
356			$CTX{""} = $root;
357			}
358
359			package AnyEvent::Log::Ctx;
360
361			# 0 1 2 3 4
362			# [$title, $level, %$parents, &$logcb, &$fmtcb]
363
364			=item $ctx->title ([$new_title])
365
366			Returns the title of the logging context - this is the package name, for
367			package contexts, and a user defined string for all others.
368
369			If C<$new_title> is given, then it replaces the package name or title.
370
371			=cut
372
373			sub title {
374			$_[0][0] = $_[1] if @_ > 1;
375			$_[0][0]
376			}
377
378			=item $ctx->levels ($level[, $level...)
379
380			Enables logging fot the given levels and disables it for all others.
381
382			=item $ctx->level ($level)
383
384			Enables logging for the given level and all lower level (higher priority)
385			ones. Specifying a level of C<0> or C<off> disables all logging for this
386			level.
387
388			Example: log warnings, errors and higher priority messages.
389
390			$ctx->level ("warn");
391			$ctx->level (5); # same thing, just numeric
392
393			=item $ctx->enable ($level[, $level...])
394
395			Enables logging for the given levels, leaving all others unchanged.
396	root	1.5
397	root	1.8	=item $ctx->disable ($level[, $level...])
398
399			Disables logging for the given levels, leaving all others unchanged.
400
401			=cut
402
403			sub _lvl_lst {
404			map { $_ > 0 && $_ <= 9 ? $_+0 : $STR2LEVEL{$_} \|\| Carp::croak "$_: not a valid logging level, caught" }
405			@_
406			}
407
408			our $NOP_CB = sub { 0 };
409
410			sub levels {
411			my $ctx = shift;
412			$ctx->[1] = 0;
413			$ctx->[1] \|= 1 << $_
414			for &_lvl_lst;
415			AnyEvent::Log::_reassess;
416			}
417
418			sub level {
419			my $ctx = shift;
420			my $lvl = $_[0] =~ /^(?:0\|off\|none)$/ ? 0 : (_lvl_lst $_[0])[0];
421			$ctx->[1] = ((1 << $lvl) - 1) << 1;
422			AnyEvent::Log::_reassess;
423			}
424
425			sub enable {
426			my $ctx = shift;
427			$ctx->[1] \|= 1 << $_
428			for &_lvl_lst;
429			AnyEvent::Log::_reassess;
430			}
431
432			sub disable {
433			my $ctx = shift;
434			$ctx->[1] &= ~(1 << $_)
435			for &_lvl_lst;
436			AnyEvent::Log::_reassess;
437			}
438
439			=item $ctx->attach ($ctx2[, $ctx3...])
440
441			Attaches the given contexts as parents to this context. It is not an error
442			to add a context twice (the second add will be ignored).
443
444			A context can be specified either as package name or as a context object.
445
446			=item $ctx->detach ($ctx2[, $ctx3...])
447
448			Removes the given parents from this context - it's not an error to attempt
449			to remove a context that hasn't been added.
450
451			A context can be specified either as package name or as a context object.
452	root	1.5
453	root	1.2	=cut
454
455	root	1.8	sub attach {
456			my $ctx = shift;
457
458			$ctx->[2]{$_+0} = $_
459			for map { AnyEvent::Log::ctx $_ } @_;
460			}
461
462			sub detach {
463			my $ctx = shift;
464
465			delete $ctx->[2]{$_+0}
466			for map { AnyEvent::Log::ctx $_ } @_;
467			}
468
469			=item $ctx->log_cb ($cb->($str))
470	root	1.5
471	root	1.8	Replaces the logging callback on the context (C<undef> disables the
472			logging callback).
473	root	1.5
474	root	1.8	The logging callback is responsible for handling formatted log messages
475			(see C<fmt_cb> below) - normally simple text strings that end with a
476			newline (and are possibly multiline themselves).
477
478			It also has to return true iff it has consumed the log message, and false
479			if it hasn't. Consuming a message means that it will not be sent to any
480			parent context. When in doubt, return C<0> from your logging callback.
481
482			Example: a very simple logging callback, simply dump the message to STDOUT
483			and do not consume it.
484
485			$ctx->log_cb (sub { print STDERR shift; 0 });
486
487			=item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message))
488
489			Replaces the fornatting callback on the cobntext (C<undef> restores the
490			default formatter).
491
492			The callback is passed the (possibly fractional) timestamp, the original
493			logging context, the (numeric) logging level and the raw message string and needs to
494			return a formatted log message. In most cases this will be a string, but
495			it could just as well be an array reference that just stores the values.
496
497			Example: format just the raw message, with numeric log level in angle
498			brackets.
499
500			$ctx->fmt_cb (sub {
501			my ($time, $ctx, $lvl, $msg) = @_;
502
503			"<$lvl>$msg\n"
504			});
505
506			Example: return an array reference with just the log values, and use
507			C<PApp::SQL::sql_exec> to store the emssage in a database.
508
509			$ctx->fmt_cb (sub { \@_ });
510			$ctx->log_cb (sub {
511			my ($msg) = @_;
512
513			sql_exec "insert into log (when, subsys, prio, msg) values (?, ?, ?, ?)",
514			$msg->[0] + 0,
515			"$msg->[1]",
516			$msg->[2] + 0,
517			"$msg->[3]";
518
519			0
520			});
521
522			=cut
523
524			sub log_cb {
525			my ($ctx, $cb) = @_;
526	root	1.6
527	root	1.8	$ctx->[3] = $cb \|\| $default_log_cb;
528	root	1.6	}
529	root	1.5
530	root	1.8	sub fmt_cb {
531			my ($ctx, $cb) = @_;
532	root	1.6
533	root	1.8	$ctx->[4] = $cb;
534	root	1.5	}
535
536	root	1.8	=item $ctx->log ($level, $msg[, @params])
537
538			Same as C<AnyEvent::Log::log>, but uses the given context as log context.
539
540			=item $logger = $ctx->logger ($level[, \$enabled])
541
542			Same as C<AnyEvent::Log::logger>, but uses the given context as log
543			context.
544
545			=cut
546
547			*log = \&AnyEvent::Log::_log;
548			*logger = \&AnyEvent::Log::_logger;
549
550	root	1.1	1;
551
552			=back
553
554			=head1 AUTHOR
555
556			Marc Lehmann <schmorp@schmorp.de>
557			http://home.schmorp.de/
558
559			=cut