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 *
#	Content
1	=head1 NAME
2
3	AnyEvent::Log - simple logging "framework"
4
5	=head1 SYNOPSIS
6
7	# 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	use AnyEvent::Log;
17
18	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	=head1 DESCRIPTION
27
28	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	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
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	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
49	=over 4
50
51	=cut
52
53	package AnyEvent::Log;
54
55	use Carp ();
56	use POSIX ();
57
58	use AnyEvent (); BEGIN { AnyEvent::common_sense }
59	use AnyEvent::Util ();
60
61	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	our %CTX; # all logging contexts
75
76	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	=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	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
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	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
123	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	=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	sub now () { time }
151	AnyEvent::post_detect {
152	*now = \&AE::now;
153	};
154
155	our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
156
157	# 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	sub _log {
168	my ($ctx, $level, $format, @args) = @_;
169
170	$level = $level > 0 && $level <= 9 ? $level+0 : $STR2LEVEL{$level} \|\| Carp::croak "$level: not a valid logging level, caught";
171
172	my $mask = 1 << $level;
173	my $now = AE::now;
174
175	my (@ctx, $did_format, $fmt);
176
177	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
202	exit 1 if $level <= 1;
203	}
204
205	sub log($$;@) {
206	_log
207	$CTX{ (caller)[0] } \|\|= _pkg_ctx +(caller)[0],
208	@_;
209	}
210
211	AnyEvent::log = AE::log = \&log;
212
213	=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	my ($ctx, $level, $renabled) = @$_;
262
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	_log $ctx, $level, sub { die };
271
272	1
273	};
274
275	$$renabled = 1; # TODO
276	}
277	}
278
279	sub _logger($;$) {
280	my ($ctx, $level, $renabled) = @_;
281
282	$renabled \|\|= \my $enabled;
283
284	$$renabled = 1;
285
286	my $logger = [$ctx, $level, $renabled];
287
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	_log $ctx, $level, @_
301	if $$renabled;
302	}
303	}
304
305	sub logger($;$) {
306	_logger
307	$CTX{ (caller)[0] } \|\|= _pkg_ctx +(caller)[0],
308	@_
309	}
310
311	#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
319	#TODO: wahst a context
320	#TODO
321
322	=over 4
323
324	=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
397	=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
453	=cut
454
455	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
471	Replaces the logging callback on the context (C<undef> disables the
472	logging callback).
473
474	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
527	$ctx->[3] = $cb \|\| $default_log_cb;
528	}
529
530	sub fmt_cb {
531	my ($ctx, $cb) = @_;
532
533	$ctx->[4] = $cb;
534	}
535
536	=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	1;
551
552	=back
553
554	=head1 AUTHOR
555
556	Marc Lehmann <schmorp@schmorp.de>
557	http://home.schmorp.de/
558
559	=cut