ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/AnyEvent/lib/AnyEvent/Log.pm

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents):
Revision 1.13 by root, Sat Aug 20 01:34:12 2011 UTC vs.
Revision 1.70 by root, Tue Sep 3 11:46:29 2019 UTC

…		…
2		2
3	AnyEvent::Log - simple logging "framework"	3	AnyEvent::Log - simple logging "framework"
4		4
5	=head1 SYNOPSIS	5	=head1 SYNOPSIS
6		6
7	# simple use	7	Simple uses:
		8
8	use AnyEvent;	9	use AnyEvent;
9		10
10	AE::log debug => "hit my knee";	11	AE::log fatal => "No config found, cannot continue!"; # never returns
11	AE::log warn => "it's a bit too hot";	12	AE::log alert => "The battery died!";
12	AE::log error => "the flag was false!";	13	AE::log crit => "The battery is too hot!";
13	AE::log fatal => "the bit toggled! run!";	14	AE::log error => "Division by zero attempted.";
		15	AE::log warn => "Couldn't delete the file.";
		16	AE::log note => "Attempted to create config, but config already exists.";
		17	AE::log info => "File soandso successfully deleted.";
		18	AE::log debug => "the function returned 3";
		19	AE::log trace => "going to call function abc";
14		20
15	# "complex" use	21	Log level overview:
		22
		23	LVL NAME SYSLOG PERL NOTE
		24	1 fatal emerg exit system unusable, aborts program!
		25	2 alert failure in primary system
		26	3 critical crit failure in backup system
		27	4 error err die non-urgent program errors, a bug
		28	5 warn warning possible problem, not necessarily error
		29	6 note notice unusual conditions
		30	7 info normal messages, no action required
		31	8 debug debugging messages for development
		32	9 trace copious tracing output
		33
		34	"Complex" uses (for speed sensitive code, e.g. trace/debug messages):
		35
16	use AnyEvent::Log;	36	use AnyEvent::Log;
17		37
18	my $tracer = AnyEvent::Log::logger trace => \$my $trace;	38	my $tracer = AnyEvent::Log::logger trace => \my $trace;
19		39
20	$tracer->("i am here") if $trace;	40	$tracer->("i am here") if $trace;
21	$tracer->(sub { "lots of data: " . Dumper $self }) if $trace;	41	$tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
22		42
23	# configuration	43	Configuration (also look at the EXAMPLES section):
24		44
25	# set logging for this package to maximum	45	# set default logging level to suppress anything below "notice"
		46	# i.e. enable logging at "notice" or above - the default is to
		47	# to not log anything at all.
		48	$AnyEvent::Log::FILTER->level ("notice");
		49
		50	# set logging for the current package to errors and higher only
26	AnyEvent::Log::ctx->level ("all");	51	AnyEvent::Log::ctx->level ("error");
27		52
28	# set logging globally to anything below debug	53	# enable logging for the current package, regardless of global logging level
		54	AnyEvent::Log::ctx->attach ($AnyEvent::Log::LOG);
		55
		56	# enable debug logging for module some::mod and enable logging by default
29	(AnyEvent::Log::ctx "")->level ("notice");	57	(AnyEvent::Log::ctx "some::mod")->level ("debug");
		58	(AnyEvent::Log::ctx "some::mod")->attach ($AnyEvent::Log::LOG);
30		59
31	# see also EXAMPLES, below	60	# send all critical and higher priority messages to syslog,
32		61	# regardless of (most) other settings
33	# disable logging for package "AnyEvent" and all packages below it	62	$AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx
34	AnyEvent->AnyEvent::Log::ctx->level (0);	63	level => "critical",
35		64	log_to_syslog => "user",
36	# log everything below debug to a file, for the whole program	65	);
37	my $ctx = AnyEvent::Log::ctx;
38	$ctx->log_cb (sub { print FILE shift; 0 });
39	(AnyEvent::Log::ctx "")->add ($ctx);
40		66
41	=head1 DESCRIPTION	67	=head1 DESCRIPTION
42		68
43	This module implements a relatively simple "logging framework". It doesn't	69	This module implements a relatively simple "logging framework". It doesn't
44	attempt to be "the" logging solution or even "a" logging solution for	70	attempt to be "the" logging solution or even "a" logging solution for
45	AnyEvent - AnyEvent simply creates logging messages internally, and this	71	AnyEvent - AnyEvent simply creates logging messages internally, and this
46	module more or less exposes the mechanism, with some extra spiff to allow	72	module more or less exposes the mechanism, with some extra spiff to allow
47	using it from other modules as well.	73	using it from other modules as well.
48		74
49	Remember that the default verbosity level is C<0>, so nothing will be	75	Remember that the default verbosity level is C<4> (C<error>), so only
50	logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number before	76	errors and more important messages will be logged, unless you set
51	starting your program, or change the logging level at runtime with	77	C<PERL_ANYEVENT_VERBOSE> to a higher number before starting your program
52	something like:	78	(C<AE_VERBOSE=5> is recommended during development), or change the logging
		79	level at runtime with something like:
53		80
54	use AnyEvent;	81	use AnyEvent::Log;
55	(AnyEvent::Log::ctx "")->level ("info");	82	$AnyEvent::Log::FILTER->level ("info");
56		83
57	The design goal behind this module was to keep it simple (and small),	84	The design goal behind this module was to keep it simple (and small),
58	but make it powerful enough to be potentially useful for any module, and	85	but make it powerful enough to be potentially useful for any module,
59	extensive enough for the most common tasks, such as logging to multiple	86	and extensive enough for the most common tasks, such as logging to
60	targets, or being able to log into a database.	87	multiple targets, or being able to log into a database.
		88
		89	The module is also usable before AnyEvent itself is initialised, in which
		90	case some of the functionality might be reduced.
		91
		92	The amount of documentation might indicate otherwise, but the runtime part
		93	of the module is still just below 300 lines of code.
		94
		95	=head1 LOGGING LEVELS
		96
		97	Logging levels in this module range from C<1> (highest priority) to C<9>
		98	(lowest priority). Note that the lowest numerical value is the highest
		99	priority, so when this document says "higher priority" it means "lower
		100	numerical value".
		101
		102	Instead of specifying levels by name you can also specify them by aliases:
		103
		104	LVL NAME SYSLOG PERL NOTE
		105	1 fatal emerg exit system unusable, aborts program!
		106	2 alert failure in primary system
		107	3 critical crit failure in backup system
		108	4 error err die non-urgent program errors, a bug
		109	5 warn warning possible problem, not necessarily error
		110	6 note notice unusual conditions
		111	7 info normal messages, no action required
		112	8 debug debugging messages for development
		113	9 trace copious tracing output
		114
		115	As you can see, some logging levels have multiple aliases - the first one
		116	is the "official" name, the second one the "syslog" name (if it differs)
		117	and the third one the "perl" name, suggesting (only!) that you log C<die>
		118	messages at C<error> priority. The NOTE column tries to provide some
		119	rationale on how to chose a logging level.
		120
		121	As a rough guideline, levels 1..3 are primarily meant for users of the
		122	program (admins, staff), and are the only ones logged to STDERR by
		123	default. Levels 4..6 are meant for users and developers alike, while
		124	levels 7..9 are usually meant for developers.
		125
		126	You can normally only log a message once at highest priority level (C<1>,
		127	C<fatal>), because logging a fatal message will also quit the program - so
		128	use it sparingly :)
		129
		130	For example, a program that finds an unknown switch on the commandline
		131	might well use a fatal logging level to tell users about it - the "system"
		132	in this case would be the program, or module.
		133
		134	Some methods also offer some extra levels, such as C<0>, C<off>, C<none>
		135	or C<all> - these are only valid for the methods that documented them.
61		136
62	=head1 LOGGING FUNCTIONS	137	=head1 LOGGING FUNCTIONS
63		138
64	These functions allow you to log messages. They always use the caller's	139	The following functions allow you to log messages. They always use the
65	package as a "logging module/source". Also, the main logging function is	140	caller's package as a "logging context". Also, the main logging function,
66	callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is	141	C<log>, is aliased to C<AnyEvent::log> and C<AE::log> when the C<AnyEvent>
67	loaded.	142	module is loaded.
68		143
69	=over 4	144	=over 4
70		145
71	=cut	146	=cut
72		147
73	package AnyEvent::Log;	148	package AnyEvent::Log;
74		149
75	use Carp ();	150	use Carp ();
76	use POSIX ();	151	use POSIX ();
77		152
		153	# layout of a context
		154	# 0 1 2 3 4, 5
		155	# [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap]
		156
78	use AnyEvent (); BEGIN { AnyEvent::common_sense }	157	use AnyEvent (); BEGIN { AnyEvent::common_sense }
79	use AnyEvent::Util ();	158	#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log
		159
		160	our $VERSION = $AnyEvent::VERSION;
		161
		162	our ($COLLECT, $FILTER, $LOG);
80		163
81	our ($now_int, $now_str1, $now_str2);	164	our ($now_int, $now_str1, $now_str2);
82		165
83	# Format Time, not public - yet?	166	# Format Time, not public - yet?
84	sub ft($) {	167	sub format_time($) {
85	my $i = int $_[0];	168	my $i = int $_[0];
86	my $f = sprintf "%06d", 1e6 * ($_[0] - $i);	169	my $f = sprintf "%06d", 1e6 * ($_[0] - $i);
87		170
88	($now_int, $now_str1, $now_str2) = ($i, split /\x01/, POSIX::strftime "%Y-%m-%d %H:%M:%S.\x01 %z", localtime $i)	171	($now_int, $now_str1, $now_str2) = ($i, split /\x01/, POSIX::strftime "%Y-%m-%d %H:%M:%S.\x01 %z", localtime $i)
89	if $now_int != $i;	172	if $now_int != $i;
90		173
91	"$now_str1$f$now_str2"	174	"$now_str1$f$now_str2"
92	}	175	}
93		176
94	our %CTX; # all logging contexts	177	our %CTX; # all package contexts
95		178
96	# creates a default package context object for the given package	179	# creates a default package context object for the given package
97	sub _pkg_ctx($) {	180	sub _pkg_ctx($) {
98	my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx";	181	my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx";
99		182
100	# link "parent" package	183	# link "parent" package
101	my $pkg = $_[0] =~ /^(.+)::/ ? $1 : "AE::Log::Top";	184	my $parent = $_[0] =~ /^(.+)::/
		185	? $CTX{$1} ||= &_pkg_ctx ("$1")
		186	: $COLLECT;
102		187
103	$pkg = $CTX{$pkg} ||= &_pkg_ctx ($pkg);
104	$ctx->[2]{$pkg+0} = $pkg;	188	$ctx->[2]{$parent+0} = $parent;
105		189
106	$ctx	190	$ctx
107	}	191	}
108		192
109	=item AnyEvent::Log::log $level, $msg[, @args]	193	=item AnyEvent::Log::log $level, $msg[, @args]
110		194
111	Requests logging of the given C<$msg> with the given log level (1..9).	195	Requests logging of the given C<$msg> with the given log level, and
112	You can also use the following strings as log level: C<fatal> (1),	196	returns true if the message was logged I<somewhere>.
113	C<alert> (2), C<critical> (3), C<error> (4), C<warn> (5), C<note> (6),
114	C<info> (7), C<debug> (8), C<trace> (9).
115		197
116	For C<fatal> log levels, the program will abort.	198	For loglevel C<fatal>, the program will abort.
117		199
118	If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the	200	If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the
119	C<$msg> is interpreted as an sprintf format string.	201	C<$msg> is interpreted as an sprintf format string.
120		202
121	The C<$msg> should not end with C<\n>, but may if that is convenient for	203	The C<$msg> should not end with C<\n>, but may if that is convenient for
…		…
124	Last not least, C<$msg> might be a code reference, in which case it is	206	Last not least, C<$msg> might be a code reference, in which case it is
125	supposed to return the message. It will be called only then the message	207	supposed to return the message. It will be called only then the message
126	actually gets logged, which is useful if it is costly to create the	208	actually gets logged, which is useful if it is costly to create the
127	message in the first place.	209	message in the first place.
128		210
		211	This function takes care of saving and restoring C<$!> and C<$@>, so you
		212	don't have to.
		213
129	Whether the given message will be logged depends on the maximum log level	214	Whether the given message will be logged depends on the maximum log level
130	and the caller's package.	215	and the caller's package. The return value can be used to ensure that
		216	messages or not "lost" - for example, when L<AnyEvent::Debug> detects a
		217	runtime error it tries to log it at C<die> level, but if that message is
		218	lost it simply uses warn.
131		219
132	Note that you can (and should) call this function as C<AnyEvent::log> or	220	Note that you can (and should) call this function as C<AnyEvent::log> or
133	C<AE::log>, without C<use>-ing this module if possible (i.e. you don't	221	C<AE::log>, without C<use>-ing this module if possible (i.e. you don't
134	need any additional functionality), as those functions will load the	222	need any additional functionality), as those functions will load the
135	logging module on demand only. They are also much shorter to write.	223	logging module on demand only. They are also much shorter to write.
…		…
152		240
153	=cut	241	=cut
154		242
155	# also allow syslog equivalent names	243	# also allow syslog equivalent names
156	our %STR2LEVEL = (	244	our %STR2LEVEL = (
157	fatal => 1, emerg => 1,	245	fatal => 1, emerg => 1, exit => 1,
158	alert => 2,	246	alert => 2,
159	critical => 3, crit => 3,	247	critical => 3, crit => 3,
160	error => 4, err => 4,	248	error => 4, err => 4, die => 4,
161	warn => 5, warning => 5,	249	warn => 5, warning => 5,
162	note => 6, notice => 6,	250	note => 6, notice => 6,
163	info => 7,	251	info => 7,
164	debug => 8,	252	debug => 8,
165	trace => 9,	253	trace => 9,
166	);	254	);
167		255
168	sub now () { time }	256	our $TIME_EXACT;
		257
		258	sub exact_time($) {
		259	$TIME_EXACT = shift;
		260	*_ts = $AnyEvent::MODEL
		261	? $TIME_EXACT ? \&AE::now : \&AE::time
		262	: sub () { $TIME_EXACT ? do { require Time::HiRes; Time::HiRes::time () } : time };
		263	}
		264
		265	BEGIN {
		266	exact_time 0;
		267	}
169		268
170	AnyEvent::post_detect {	269	AnyEvent::post_detect {
171	*now = \&AE::now;	270	exact_time $TIME_EXACT;
172	};	271	};
173		272
174	our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);	273	our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
175		274
176	# time, ctx, level, msg	275	# time, ctx, level, msg
177	sub _format($$$$) {	276	sub default_format($$$$) {
178	my $ts = ft $_[0];	277	my $ts = format_time $_[0];
179	my $ct = " ";	278	my $ct = " ";
180		279
181	my @res;	280	my @res;
182		281
183	for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) {	282	for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) {
…		…
186	}	285	}
187		286
188	join "", @res	287	join "", @res
189	}	288	}
190		289
		290	sub fatal_exit() {
		291	exit 1;
		292	}
		293
191	sub _log {	294	sub _log {
192	my ($ctx, $level, $format, @args) = @_;	295	my ($ctx, $level, $format, @args) = @_;
193		296
194	$level = $level > 0 && $level <= 9	297	$level = $level > 0 && $level <= 9
195	? $level+0	298	? $level+0
196	: $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";	299	: $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
197		300
198	my $mask = 1 << $level;	301	my $mask = 1 << $level;
199		302
200	my (%seen, @ctx, $now, $fmt);	303	my ($success, %seen, @ctx, $now, @fmt);
201		304
202	do	305	do
203	{	306	{
204	# skip if masked	307	# if !ref, then it's a level number
		308	if (!ref $ctx) {
		309	$level = $ctx;
205	if ($ctx->[1] & $mask && !$seen{$ctx+0}++) {	310	} elsif ($ctx->[1] & $mask and !$seen{$ctx+0}++) {
		311	# logging/recursing into this context
		312
		313	# level cap
		314	if ($ctx->[5] > $level) {
		315	push @ctx, $level; # restore level when going up in tree
		316	$level = $ctx->[5];
		317	}
		318
		319	# log if log cb
206	if ($ctx->[3]) {	320	if ($ctx->[3]) {
207	# logging target found	321	# logging target found
		322
		323	local ($!, $@);
208		324
209	# now get raw message, unless we have it already	325	# now get raw message, unless we have it already
210	unless ($now) {	326	unless ($now) {
211	$format = $format->() if ref $format;	327	$format = $format->() if ref $format;
212	$format = sprintf $format, @args if @args;	328	$format = sprintf $format, @args if @args;
213	$format =~ s/\n$//;	329	$format =~ s/\n$//;
214	$now = AE::now;	330	$now = _ts;
215	};	331	};
216		332
217	# format msg	333	# format msg
218	my $str = $ctx->[4]	334	my $str = $ctx->[4]
219	? $ctx->[4]($now, $_[0], $level, $format)	335	? $ctx->[4]($now, $_[0], $level, $format)
220	: $fmt ||= _format $now, $_[0], $level, $format;	336	: ($fmt[$level] ||= default_format $now, $_[0], $level, $format);
221		337
		338	$success = 1;
		339
222	$ctx->[3]($str);	340	$ctx->[3]($str)
		341	or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
		342	} else {
		343	push @ctx, values %{ $ctx->[2] }; # not masked - propagate
223	}	344	}
224
225	# not masked, not consumed - propagate to parent contexts
226	push @ctx, values %{ $ctx->[2] };
227	}	345	}
228	}	346	}
229	while $ctx = pop @ctx;	347	while $ctx = pop @ctx;
230		348
231	exit 1 if $level <= 1;	349	fatal_exit if $level <= 1;
		350
		351	$success
232	}	352	}
233		353
234	sub log($$;@) {	354	sub log($$;@) {
235	_log	355	_log
236	$CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],	356	$CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
237	@_;	357	@_;
238	}	358	}
239		359
240	*AnyEvent::log = *AE::log = \&log;
241
242	=item $logger = AnyEvent::Log::logger $level[, \$enabled]	360	=item $logger = AnyEvent::Log::logger $level[, \$enabled]
243		361
244	Creates a code reference that, when called, acts as if the	362	Creates a code reference that, when called, acts as if the
245	C<AnyEvent::Log::log> function was called at this point with the givne	363	C<AnyEvent::Log::log> function was called at this point with the given
246	level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with	364	level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
247	the C<AnyEvent::Log::log> function:	365	the C<AnyEvent::Log::log> function:
248		366
249	my $debug_log = AnyEvent::Log::logger "debug";	367	my $debug_log = AnyEvent::Log::logger "debug";
250		368
…		…
275	# and later in your program	393	# and later in your program
276	$debug_log->("yo, stuff here") if $debug;	394	$debug_log->("yo, stuff here") if $debug;
277		395
278	$debug and $debug_log->("123");	396	$debug and $debug_log->("123");
279		397
280	Note: currently the enabled var is always true - that will be fixed in a
281	future version :)
282
283	=cut	398	=cut
284		399
285	our %LOGGER;	400	our %LOGGER;
286		401
287	# re-assess logging status for all loggers	402	# re-assess logging status for all loggers
288	sub _reassess {	403	sub _reassess {
		404	local $SIG{__DIE__};
		405	my $die = sub { die };
		406
289	for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {	407	for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
290	my ($ctx, $level, $renabled) = @$_;	408	my ($ctx, $level, $renabled) = @$_;
291		409
292	# to detect whether a message would be logged, we # actually	410	# to detect whether a message would be logged, we actually
293	# try to log one and die. this isn't fast, but we can be	411	# try to log one and die. this isn't fast, but we can be
294	# sure that the logging decision is correct :)	412	# sure that the logging decision is correct :)
295		413
296	$$renabled = !eval {	414	$$renabled = !eval {
297	local $SIG{__DIE__};
298
299	_log $ctx, $level, sub { die };	415	_log $ctx, $level, $die;
300		416
301	1	417	1
302	};	418	};
303
304	$$renabled = 1; # TODO
305	}	419	}
306	}	420	}
307		421
308	sub _logger($;$) {	422	sub _logger {
309	my ($ctx, $level, $renabled) = @_;	423	my ($ctx, $level, $renabled) = @_;
310		424
311	$renabled ||= \my $enabled;
312
313	$$renabled = 1;	425	$$renabled = 1;
314		426
315	my $logger = [$ctx, $level, $renabled];	427	my $logger = [$ctx, $level, $renabled];
316		428
317	$LOGGER{$logger+0} = $logger;	429	$LOGGER{$logger+0} = $logger;
318		430
319	_reassess $logger+0;	431	_reassess $logger+0;
320		432
		433	require AnyEvent::Util unless $AnyEvent::Util::VERSION;
321	my $guard = AnyEvent::Util::guard {	434	my $guard = AnyEvent::Util::guard (sub {
322	# "clean up"	435	# "clean up"
323	delete $LOGGER{$logger+0};	436	delete $LOGGER{$logger+0};
324	};	437	});
325		438
326	sub {	439	sub {
327	$guard if 0; # keep guard alive, but don't cause runtime overhead	440	$guard if 0; # keep guard alive, but don't cause runtime overhead
328		441
329	_log $ctx, $level, @_	442	_log $ctx, $level, @_
…		…
334	sub logger($;$) {	447	sub logger($;$) {
335	_logger	448	_logger
336	$CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],	449	$CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
337	@_	450	@_
338	}	451	}
		452
		453	=item AnyEvent::Log::exact_time $on
		454
		455	By default, C<AnyEvent::Log> will use C<AE::now>, i.e. the cached
		456	eventloop time, for the log timestamps. After calling this function with a
		457	true value it will instead resort to C<AE::time>, i.e. fetch the current
		458	time on each log message. This only makes a difference for event loops
		459	that actually cache the time (such as L<EV> or L<AnyEvent::Loop>).
		460
		461	This setting can be changed at any time by calling this function.
		462
		463	Since C<AnyEvent::Log> has to work even before the L<AnyEvent> has been
		464	initialised, this switch will also decide whether to use C<CORE::time> or
		465	C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes
		466	available.
		467
		468	=item AnyEvent::Log::format_time $timestamp
		469
		470	Formats a timestamp as returned by C<< AnyEvent->now >> or C<<
		471	AnyEvent->time >> or many other functions in the same way as
		472	C<AnyEvent::Log> does.
		473
		474	In your main program (as opposed to in your module) you can override
		475	the default timestamp display format by loading this module and then
		476	redefining this function.
		477
		478	Most commonly, this function can be used in formatting callbacks.
		479
		480	=item AnyEvent::Log::default_format $time, $ctx, $level, $msg
		481
		482	Format a log message using the given timestamp, logging context, log level
		483	and log message.
		484
		485	This is the formatting function used to format messages when no custom
		486	function is provided.
		487
		488	In your main program (as opposed to in your module) you can override the
		489	default message format by loading this module and then redefining this
		490	function.
		491
		492	=item AnyEvent::Log::fatal_exit()
		493
		494	This is the function that is called after logging a C<fatal> log
		495	message. It must not return.
		496
		497	The default implementation simply calls C<exit 1>.
		498
		499	In your main program (as opposed to in your module) you can override
		500	the fatal exit function by loading this module and then redefining this
		501	function. Make sure you don't return.
339		502
340	=back	503	=back
341		504
342	=head1 LOGGING CONTEXTS	505	=head1 LOGGING CONTEXTS
343		506
…		…
356	timestamp, context, level and string message and formats it in the way	519	timestamp, context, level and string message and formats it in the way
357	it should be logged) and a logging callback (which is responsible for	520	it should be logged) and a logging callback (which is responsible for
358	actually logging the formatted message and telling C<AnyEvent::Log>	521	actually logging the formatted message and telling C<AnyEvent::Log>
359	whether it has consumed the message, or whether it should be propagated).	522	whether it has consumed the message, or whether it should be propagated).
360		523
361	For propagation, a context can have any number of attached I<parent	524	For propagation, a context can have any number of attached I<slave
362	contexts>. Any message that is neither masked by the logging mask nor	525	contexts>. Any message that is neither masked by the logging mask nor
363	masked by the logging callback returning true will be passed to all parent	526	masked by the logging callback returning true will be passed to all slave
364	contexts.	527	contexts.
365		528
366	Each call to a logging function will log the message at most once per	529	Each call to a logging function will log the message at most once per
367	context, so it does not matter (much) if there are cycles or if the	530	context, so it does not matter (much) if there are cycles or if the
368	message can arrive at the same context via multiple paths.	531	message can arrive at the same context via multiple paths.
…		…
372	By default, all logging contexts have an full set of log levels ("all"), a	535	By default, all logging contexts have an full set of log levels ("all"), a
373	disabled logging callback and the default formatting callback.	536	disabled logging callback and the default formatting callback.
374		537
375	Package contexts have the package name as logging title by default.	538	Package contexts have the package name as logging title by default.
376		539
377	They have exactly one parent - the context of the "parent" package. The	540	They have exactly one slave - the context of the "parent" package. The
378	parent package is simply defined to be the package name without the last	541	parent package is simply defined to be the package name without the last
379	component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>,	542	component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>,
380	and C<AnyEvent> becomes ... C<AnyEvent::Log::Top> which is the	543	and C<AnyEvent> becomes ... C<$AnyEvent::Log::COLLECT> which is the
381	exception of the rule - just like the parent of any package name in	544	exception of the rule - just like the "parent" of any single-component
382	Perl is C<main>, the default parent of any top-level package context is	545	package name in Perl is C<main>, the default slave of any top-level
383	C<AnyEvent::Log::Top>.	546	package context is C<$AnyEvent::Log::COLLECT>.
384		547
385	Since perl packages form only an approximate hierarchy, this parent	548	Since perl packages form only an approximate hierarchy, this slave
386	context can of course be removed.	549	context can of course be removed.
387		550
388	All other (anonymous) contexts have no parents and an empty title by	551	All other (anonymous) contexts have no slaves and an empty title by
389	default.	552	default.
390		553
391	When the module is loaded it creates the default context called	554	When the module is loaded it creates the C<$AnyEvent::Log::LOG> logging
392	C<AnyEvent::Log::Default> (also stored in C<$AnyEvent::Log::Default>),	555	context that simply logs everything via C<warn>, without propagating
393	which simply logs everything to STDERR and doesn't propagate anything
394	anywhere by default. The purpose of the default context is to provide	556	anything anywhere by default. The purpose of this context is to provide
395	a convenient place to override the global logging target or to attach	557	a convenient place to override the global logging target or to attach
396	additional log targets. It's not meant for filtering.	558	additional log targets. It's not meant for filtering.
397		559
398	It then creates the root context called C<AnyEvent::Log::Root> (also	560	It then creates the C<$AnyEvent::Log::FILTER> context whose
399	stored in C<$AnyEvent::Log::Root>) and sets its log level set to all	561	purpose is to suppress all messages with priority higher
400	levels up to the one specified by C<$ENV{PERL_ANYEVENT_VERBOSE}>. It	562	than C<$ENV{PERL_ANYEVENT_VERBOSE}>. It then attached the
401	then attached the default logging context to it. The purpose of the root	563	C<$AnyEvent::Log::LOG> context to it. The purpose of the filter context
402	context is to simply provide filtering according to some global log level.	564	is to simply provide filtering according to some global log level.
403		565
404	Finally it creates the top-level package context called	566	Finally it creates the top-level package context C<$AnyEvent::Log::COLLECT>
405	C<AnyEvent::Log::Top> (also stored in, you might have guessed,	567	and attaches the C<$AnyEvent::Log::FILTER> context to it, but otherwise
406	C<$AnyEvent::Log::Top>) and attached the root context but otherwise leaves
407	it at default config. It's purpose is simply to collect all log messages	568	leaves it at default config. Its purpose is simply to collect all log
408	system-wide.	569	messages system-wide.
409		570
410	These three special contexts can also be referred to by the	571	The hierarchy is then:
411	package/context names C<AE::Log::Default>, C<AE::Log::Root> and
412	C<AE::Log::Top>.
413		572
		573	any package, eventually -> $COLLECT -> $FILTER -> $LOG
		574
414	The effect of all this is that log messages, by default, wander up	575	The effect of all this is that log messages, by default, wander up to the
415	to the root context where log messages with lower priority then	576	C<$AnyEvent::Log::COLLECT> context where all messages normally end up,
		577	from there to C<$AnyEvent::Log::FILTER> where log messages with lower
416	C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered away and then to the	578	priority then C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered out and then
417	AnyEvent::Log::Default context to be logged to STDERR.	579	to the C<$AnyEvent::Log::LOG> context to be passed to C<warn>.
418		580
419	Splitting the top level context into three contexts makes it easy to set	581	This makes it easy to set a global logging level (by modifying $FILTER),
420	a global logging level (by modifying the root context), but still allow	582	but still allow other contexts to send, for example, their debug and trace
421	other contexts to log, for example, their debug and trace messages to the
422	default target despite the global logging level, or to attach additional	583	messages to the $LOG target despite the global logging level, or to attach
423	log targets that log messages, regardless of the global logging level.	584	additional log targets that log messages, regardless of the global logging
		585	level.
424		586
425	It also makes it easy to replace the default STDERR-logger by something	587	It also makes it easy to modify the default warn-logger ($LOG) to
426	that logs to a file, or to attach additional logging targets.	588	something that logs to a file, or to attach additional logging targets
		589	(such as loggign to a file) by attaching it to $FILTER.
427		590
428	=head2 CREATING/FINDING/DESTROYING CONTEXTS	591	=head2 CREATING/FINDING/DESTROYING CONTEXTS
429		592
430	=over 4	593	=over 4
431		594
432	=item $ctx = AnyEvent::Log::ctx [$pkg]	595	=item $ctx = AnyEvent::Log::ctx [$pkg]
433		596
434	This function creates or returns a logging context (which is an object).	597	This function creates or returns a logging context (which is an object).
435		598
436	If a package name is given, then the context for that packlage is	599	If a package name is given, then the context for that package is
437	returned. If it is called without any arguments, then the context for the	600	returned. If it is called without any arguments, then the context for the
438	callers package is returned (i.e. the same context as a C<AE::log> call	601	callers package is returned (i.e. the same context as a C<AE::log> call
439	would use).	602	would use).
440		603
441	If C<undef> is given, then it creates a new anonymous context that is not	604	If C<undef> is given, then it creates a new anonymous context that is not
…		…
453	: bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx"	616	: bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx"
454	}	617	}
455		618
456	=item AnyEvent::Log::reset	619	=item AnyEvent::Log::reset
457		620
458	Deletes all contexts and recreates the default hierarchy, i.e. resets the	621	Resets all package contexts and recreates the default hierarchy if
459	logging subsystem to defaults.	622	necessary, i.e. resets the logging subsystem to defaults, as much as
		623	possible. This process keeps references to contexts held by other parts of
		624	the program intact.
460		625
461	This can be used to implement config-file (re-)loading: before loading a	626	This can be used to implement config-file (re-)loading: before loading a
462	configuration, reset all contexts.	627	configuration, reset all contexts.
463		628
464	=cut	629	=cut
465		630
		631	our $ORIG_VERBOSE = $AnyEvent::VERBOSE;
		632	$AnyEvent::VERBOSE = 9;
		633
466	sub reset {	634	sub reset {
467	@$_ = () for values %CTX; # just to be sure - to kill circular logging dependencies	635	# hard to kill complex data structures
468	%CTX = ();	636	# we "recreate" all package loggers and reset the hierarchy
		637	while (my ($k, $v) = each %CTX) {
		638	@$v = ($k, (1 << 10) - 1 - 1, { });
469		639
470	my $default = ctx undef;	640	$v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log::COLLECT);
471	$default->title ("AnyEvent::Log::Default");
472	$default->log_cb (sub {
473	print STDERR shift;
474	0
475	});	641	}
476	$AnyEvent::Log::Default = $CTX{"AnyEvent::Log::Default"} = $CTX{"AE::Log::Default"} = $default;
477		642
478	my $root = ctx undef;	643	@$_ = ($_->[0], (1 << 10) - 1 - 1)
479	$root->title ("AnyEvent::Log::Root");	644	for $LOG, $FILTER, $COLLECT;
480	$root->level ($AnyEvent::VERBOSE);
481	$root->attach ($default);
482	$AnyEvent::Log::Root = $CTX{"AnyEvent::Log::Root"} = $CTX{"AE::Log::Root"} = $root;
483		645
484	my $top = ctx undef;	646	#$LOG->slaves;
485	$top->title ("AnyEvent::Log::Top");	647	$LOG->title ('$AnyEvent::Log::LOG');
486	$top->attach ($root);	648	$LOG->log_to_warn;
487	$AnyEvent::Log::Top = $CTX{"AnyEvent::Log::Top"} = $CTX{"AE::Log::Top"} = $top;	649
		650	$FILTER->slaves ($LOG);
		651	$FILTER->title ('$AnyEvent::Log::FILTER');
		652	$FILTER->level ($ORIG_VERBOSE);
		653
		654	$COLLECT->slaves ($FILTER);
		655	$COLLECT->title ('$AnyEvent::Log::COLLECT');
		656
		657	_reassess;
488	}	658	}
		659
		660	# override AE::log/logger
		661	*AnyEvent::log = *AE::log = \&log;
		662	*AnyEvent::logger = *AE::logger = \&logger;
		663
		664	# convert AnyEvent loggers to AnyEvent::Log loggers
		665	$_->[0] = ctx $_->[0] # convert "pkg" to "ctx"
		666	for values %LOGGER;
		667
		668	# create the default logger contexts
		669	$LOG = ctx undef;
		670	$FILTER = ctx undef;
		671	$COLLECT = ctx undef;
489		672
490	AnyEvent::Log::reset;	673	AnyEvent::Log::reset;
491		674
492	# hello, CPAN, please catch me	675	# hello, CPAN, please catch me
493	package AnyEvent::Log::Default;
494	package AE::Log::Default;
495	package AnyEvent::Log::Root;
496	package AE::Log::Root;
497	package AnyEvent::Log::Top;	676	package AnyEvent::Log::LOG;
498	package AE::Log::Top;	677	package AE::Log::LOG;
		678	package AnyEvent::Log::FILTER;
		679	package AE::Log::FILTER;
		680	package AnyEvent::Log::COLLECT;
		681	package AE::Log::COLLECT;
499		682
500	package AnyEvent::Log::Ctx;	683	package AnyEvent::Log::Ctx;
501
502	# 0 1 2 3 4
503	# [$title, $level, %$parents, &$logcb, &$fmtcb]
504		684
505	=item $ctx = new AnyEvent::Log::Ctx methodname => param...	685	=item $ctx = new AnyEvent::Log::Ctx methodname => param...
506		686
507	This is a convenience constructor that makes it simpler to construct	687	This is a convenience constructor that makes it simpler to construct
508	anonymous logging contexts.	688	anonymous logging contexts.
…		…
511	name as the key with the value as parameter, unless the value is an	691	name as the key with the value as parameter, unless the value is an
512	arrayref, in which case it calls the method with the contents of the	692	arrayref, in which case it calls the method with the contents of the
513	array. The methods are called in the same order as specified.	693	array. The methods are called in the same order as specified.
514		694
515	Example: create a new logging context and set both the default logging	695	Example: create a new logging context and set both the default logging
516	level, some parent contexts and a logging callback.	696	level, some slave contexts and a logging callback.
517		697
518	$ctx = new AnyEvent::Log::Ctx	698	$ctx = new AnyEvent::Log::Ctx
519	title => "dubious messages",	699	title => "dubious messages",
520	level => "error",	700	level => "error",
521	log_cb => sub { print STDOUT shift; 0 },	701	log_cb => sub { print STDOUT shift; 0 },
522	parents => [$ctx1, $ctx, $ctx2],	702	slaves => [$ctx1, $ctx, $ctx2],
523	;	703	;
524		704
525	=back	705	=back
526		706
527	=cut	707	=cut
…		…
595	Enables logging for the given levels, leaving all others unchanged.	775	Enables logging for the given levels, leaving all others unchanged.
596		776
597	=item $ctx->disable ($level[, $level...])	777	=item $ctx->disable ($level[, $level...])
598		778
599	Disables logging for the given levels, leaving all others unchanged.	779	Disables logging for the given levels, leaving all others unchanged.
		780
		781	=item $ctx->cap ($level)
		782
		783	Caps the maximum priority to the given level, for all messages logged
		784	to, or passing through, this context. That is, while this doesn't affect
		785	whether a message is logged or passed on, the maximum priority of messages
		786	will be limited to the specified level - messages with a higher priority
		787	will be set to the specified priority.
		788
		789	Another way to view this is that C<< ->level >> filters out messages with
		790	a too low priority, while C<< ->cap >> modifies messages with a too high
		791	priority.
		792
		793	This is useful when different log targets have different interpretations
		794	of priority. For example, for a specific command line program, a wrong
		795	command line switch might well result in a C<fatal> log message, while the
		796	same message, logged to syslog, is likely I<not> fatal to the system or
		797	syslog facility as a whole, but more likely a mere C<error>.
		798
		799	This can be modeled by having a stderr logger that logs messages "as-is"
		800	and a syslog logger that logs messages with a level cap of, say, C<error>,
		801	or, for truly system-critical components, actually C<critical>.
600		802
601	=cut	803	=cut
602		804
603	sub _lvl_lst {	805	sub _lvl_lst {
604	map {	806	map {
…		…
606	: $_ eq "all" ? (1 .. 9)	808	: $_ eq "all" ? (1 .. 9)
607	: $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"	809	: $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
608	} @_	810	} @_
609	}	811	}
610		812
		813	sub _lvl {
		814	$_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]
		815	}
		816
611	our $NOP_CB = sub { 0 };	817	our $NOP_CB = sub { 0 };
612		818
613	sub levels {	819	sub levels {
614	my $ctx = shift;	820	my $ctx = shift;
615	$ctx->[1] = 0;	821	$ctx->[1] = 0;
…		…
618	AnyEvent::Log::_reassess;	824	AnyEvent::Log::_reassess;
619	}	825	}
620		826
621	sub level {	827	sub level {
622	my $ctx = shift;	828	my $ctx = shift;
623	my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
624
625	$ctx->[1] = ((1 << $lvl) - 1) << 1;	829	$ctx->[1] = ((1 << &_lvl) - 1) << 1;
626	AnyEvent::Log::_reassess;	830	AnyEvent::Log::_reassess;
627	}	831	}
628		832
629	sub enable {	833	sub enable {
630	my $ctx = shift;	834	my $ctx = shift;
…		…
638	$ctx->[1] &= ~(1 << $_)	842	$ctx->[1] &= ~(1 << $_)
639	for &_lvl_lst;	843	for &_lvl_lst;
640	AnyEvent::Log::_reassess;	844	AnyEvent::Log::_reassess;
641	}	845	}
642		846
		847	sub cap {
		848	my $ctx = shift;
		849	$ctx->[5] = &_lvl;
		850	}
		851
643	=back	852	=back
644		853
645	=head3 PARENT CONTEXTS	854	=head3 SLAVE CONTEXTS
646		855
647	The following methods attach and detach another logging context to a	856	The following methods attach and detach another logging context to a
648	logging context.	857	logging context.
649		858
650	Log messages are propagated to all parent contexts, unless the logging	859	Log messages are propagated to all slave contexts, unless the logging
651	callback consumes the message.	860	callback consumes the message.
652		861
653	=over 4	862	=over 4
654		863
655	=item $ctx->attach ($ctx2[, $ctx3...])	864	=item $ctx->attach ($ctx2[, $ctx3...])
656		865
657	Attaches the given contexts as parents to this context. It is not an error	866	Attaches the given contexts as slaves to this context. It is not an error
658	to add a context twice (the second add will be ignored).	867	to add a context twice (the second add will be ignored).
659		868
660	A context can be specified either as package name or as a context object.	869	A context can be specified either as package name or as a context object.
661		870
662	=item $ctx->detach ($ctx2[, $ctx3...])	871	=item $ctx->detach ($ctx2[, $ctx3...])
663		872
664	Removes the given parents from this context - it's not an error to attempt	873	Removes the given slaves from this context - it's not an error to attempt
665	to remove a context that hasn't been added.	874	to remove a context that hasn't been added.
666		875
667	A context can be specified either as package name or as a context object.	876	A context can be specified either as package name or as a context object.
668		877
669	=item $ctx->parents ($ctx2[, $ctx3...])	878	=item $ctx->slaves ($ctx2[, $ctx3...])
670		879
671	Replaces all parents attached to this context by the ones given.	880	Replaces all slaves attached to this context by the ones given.
672		881
673	=cut	882	=cut
674		883
675	sub attach {	884	sub attach {
676	my $ctx = shift;	885	my $ctx = shift;
677		886
678	$ctx->[2]{$_+0} = $_	887	$ctx->[2]{$_+0} = $_
679	for map { AnyEvent::Log::ctx $_ } @_;	888	for map { AnyEvent::Log::ctx $_ } @_;
		889	AnyEvent::Log::_reassess;
680	}	890	}
681		891
682	sub detach {	892	sub detach {
683	my $ctx = shift;	893	my $ctx = shift;
684		894
685	delete $ctx->[2]{$_+0}	895	delete $ctx->[2]{$_+0}
686	for map { AnyEvent::Log::ctx $_ } @_;	896	for map { AnyEvent::Log::ctx $_ } @_;
		897	AnyEvent::Log::_reassess;
687	}	898	}
688		899
689	sub parents {	900	sub slaves {
690	undef $_[0][2];	901	undef $_[0][2];
691	&attach;	902	&attach;
		903	AnyEvent::Log::_reassess;
692	}	904	}
693		905
694	=back	906	=back
695		907
696	=head3 MESSAGE LOGGING	908	=head3 LOG TARGETS
697		909
698	The following methods configure how the logging context actually does	910	The following methods configure how the logging context actually does
699	the logging (which consists of formatting the message and printing it or	911	the logging (which consists of formatting the message and printing it or
700	whatever it wants to do with it) and also allows you to log messages	912	whatever it wants to do with it).
701	directly to a context, without going via your package context.
702		913
703	=over 4	914	=over 4
704		915
705	=item $ctx->log_cb ($cb->($str))	916	=item $ctx->log_cb ($cb->($str))
706		917
…		…
711	(see C<fmt_cb> below) - normally simple text strings that end with a	922	(see C<fmt_cb> below) - normally simple text strings that end with a
712	newline (and are possibly multiline themselves).	923	newline (and are possibly multiline themselves).
713		924
714	It also has to return true iff it has consumed the log message, and false	925	It also has to return true iff it has consumed the log message, and false
715	if it hasn't. Consuming a message means that it will not be sent to any	926	if it hasn't. Consuming a message means that it will not be sent to any
716	parent context. When in doubt, return C<0> from your logging callback.	927	slave context. When in doubt, return C<0> from your logging callback.
717		928
718	Example: a very simple logging callback, simply dump the message to STDOUT	929	Example: a very simple logging callback, simply dump the message to STDOUT
719	and do not consume it.	930	and do not consume it.
720		931
721	$ctx->log_cb (sub { print STDERR shift; 0 });	932	$ctx->log_cb (sub { print STDERR shift; 0 });
…		…
729	your program.	940	your program.
730		941
731	$ctx->levels ("debug", "trace");	942	$ctx->levels ("debug", "trace");
732	$ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages	943	$ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
733		944
734	=item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message))	945	=item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
735		946
736	Replaces the formatting callback on the context (C<undef> restores the	947	Replaces the formatting callback on the context (C<undef> restores the
737	default formatter).	948	default formatter).
738		949
739	The callback is passed the (possibly fractional) timestamp, the original	950	The callback is passed the (possibly fractional) timestamp, the original
740	logging context, the (numeric) logging level and the raw message string and needs to	951	logging context (object, not title), the (numeric) logging level and
741	return a formatted log message. In most cases this will be a string, but	952	the raw message string and needs to return a formatted log message. In
742	it could just as well be an array reference that just stores the values.	953	most cases this will be a string, but it could just as well be an array
		954	reference that just stores the values.
		955
		956	If, for some reason, you want to use C<caller> to find out more about the
		957	logger then you should walk up the call stack until you are no longer
		958	inside the C<AnyEvent::Log> package.
		959
		960	To implement your own logging callback, you might find the
		961	C<AnyEvent::Log::format_time> and C<AnyEvent::Log::default_format>
		962	functions useful.
		963
		964	Example: format the message just as AnyEvent::Log would, by letting
		965	AnyEvent::Log do the work. This is a good basis to design a formatting
		966	callback that only changes minor aspects of the formatting.
		967
		968	$ctx->fmt_cb (sub {
		969	my ($time, $ctx, $lvl, $msg) = @_;
		970
		971	AnyEvent::Log::default_format $time, $ctx, $lvl, $msg
		972	});
743		973
744	Example: format just the raw message, with numeric log level in angle	974	Example: format just the raw message, with numeric log level in angle
745	brackets.	975	brackets.
746		976
747	$ctx->fmt_cb (sub {	977	$ctx->fmt_cb (sub {
…		…
749		979
750	"<$lvl>$msg\n"	980	"<$lvl>$msg\n"
751	});	981	});
752		982
753	Example: return an array reference with just the log values, and use	983	Example: return an array reference with just the log values, and use
754	C<PApp::SQL::sql_exec> to store the emssage in a database.	984	C<PApp::SQL::sql_exec> to store the message in a database.
755		985
756	$ctx->fmt_cb (sub { \@_ });	986	$ctx->fmt_cb (sub { \@_ });
757	$ctx->log_cb (sub {	987	$ctx->log_cb (sub {
758	my ($msg) = @_;	988	my ($msg) = @_;
759		989
…		…
764	"$msg->[3]";	994	"$msg->[3]";
765		995
766	0	996	0
767	});	997	});
768		998
		999	=item $ctx->log_to_warn
		1000
		1001	Sets the C<log_cb> to simply use C<CORE::warn> to report any messages
		1002	(usually this logs to STDERR).
		1003
		1004	=item $ctx->log_to_file ($path)
		1005
		1006	Sets the C<log_cb> to log to a file (by appending), unbuffered. The
		1007	function might return before the log file has been opened or created.
		1008
		1009	=item $ctx->log_to_path ($path)
		1010
		1011	Same as C<< ->log_to_file >>, but opens the file for each message. This
		1012	is much slower, but allows you to change/move/rename/delete the file at
		1013	basically any time.
		1014
		1015	Needless(?) to say, if you do not want to be bitten by some evil person
		1016	calling C<chdir>, the path should be absolute. Doesn't help with
		1017	C<chroot>, but hey...
		1018
		1019	=item $ctx->log_to_syslog ([$facility])
		1020
		1021	Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and
		1022	all the others in the obvious way. If specified, then the C<$facility> is
		1023	used as the facility (C<user>, C<auth>, C<local0> and so on). The default
		1024	facility is C<user>.
		1025
		1026	Note that this function also sets a C<fmt_cb> - the logging part requires
		1027	an array reference with [$level, $str] as input.
		1028
769	=cut	1029	=cut
770		1030
771	sub log_cb {	1031	sub log_cb {
772	my ($ctx, $cb) = @_;	1032	my ($ctx, $cb) = @_;
773		1033
…		…
778	my ($ctx, $cb) = @_;	1038	my ($ctx, $cb) = @_;
779		1039
780	$ctx->[4] = $cb;	1040	$ctx->[4] = $cb;
781	}	1041	}
782		1042
		1043	sub log_to_warn {
		1044	my ($ctx, $path) = @_;
		1045
		1046	$ctx->log_cb (sub {
		1047	warn shift;
		1048	0
		1049	});
		1050	}
		1051
		1052	# this function is a good example of why threads are a must,
		1053	# simply for priority inversion.
		1054	sub _log_to_disk {
		1055	# eval'uating this at runtime saves 220kb rss - perl has become
		1056	# an insane memory waster.
		1057	eval q{ # poor man's autoloading {}
		1058	sub _log_to_disk {
		1059	my ($ctx, $path, $keepopen) = @_;
		1060
		1061	my $fh;
		1062	my @queue;
		1063	my $delay;
		1064	my $disable;
		1065
		1066	use AnyEvent::IO ();
		1067
		1068	my $kick = sub {
		1069	undef $delay;
		1070	return unless @queue;
		1071	$delay = 1;
		1072
		1073	# we pass $kick to $kick, so $kick itself doesn't keep a reference to $kick.
		1074	my $kick = shift;
		1075
		1076	# write one or more messages
		1077	my $write = sub {
		1078	# we write as many messages as have been queued
		1079	my $data = join "", @queue;
		1080	@queue = ();
		1081
		1082	AnyEvent::IO::aio_write $fh, $data, sub {
		1083	$disable = 1;
		1084	@_
		1085	? ($_[0] == length $data or AE::log 4 => "unable to write to logfile '$path': short write")
		1086	: AE::log 4 => "unable to write to logfile '$path': $!";
		1087	undef $disable;
		1088
		1089	if ($keepopen) {
		1090	$kick->($kick);
		1091	} else {
		1092	AnyEvent::IO::aio_close ($fh, sub {
		1093	undef $fh;
		1094	$kick->($kick);
		1095	});
		1096	}
		1097	};
		1098	};
		1099
		1100	if ($fh) {
		1101	$write->();
		1102	} else {
		1103	AnyEvent::IO::aio_open
		1104	$path,
		1105	AnyEvent::IO::O_CREAT | AnyEvent::IO::O_WRONLY | AnyEvent::IO::O_APPEND,
		1106	0666,
		1107	sub {
		1108	$fh = shift
		1109	or do {
		1110	$disable = 1;
		1111	AE::log 4 => "unable to open logfile '$path': $!";
		1112	undef $disable;
		1113	return;
		1114	};
		1115
		1116	$write->();
		1117	}
		1118	;
		1119	}
		1120	};
		1121
		1122	$ctx->log_cb (sub {
		1123	return if $disable;
		1124	push @queue, shift;
		1125	$kick->($kick) unless $delay;
		1126	0
		1127	});
		1128
		1129	$kick->($kick) if $keepopen; # initial open
		1130	};
		1131	};
		1132	die if $@;
		1133	&_log_to_disk
		1134	}
		1135
		1136	sub log_to_file {
		1137	my ($ctx, $path) = @_;
		1138
		1139	_log_to_disk $ctx, $path, 1;
		1140	}
		1141
		1142	sub log_to_path {
		1143	my ($ctx, $path) = @_;
		1144
		1145	_log_to_disk $ctx, $path, 0;
		1146	}
		1147
		1148	sub log_to_syslog {
		1149	my ($ctx, $facility) = @_;
		1150
		1151	require Sys::Syslog;
		1152
		1153	$ctx->fmt_cb (sub {
		1154	my $str = $_[3];
		1155	$str =~ s/\n(?=.)/\n+ /g;
		1156
		1157	[$_[2], "($_[1][0]) $str"]
		1158	});
		1159
		1160	$facility ||= "user";
		1161
		1162	$ctx->log_cb (sub {
		1163	my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
		1164
		1165	Sys::Syslog::syslog ("$facility|" . ($lvl - 1), $_)
		1166	for split /\n/, $_[0][1];
		1167
		1168	0
		1169	});
		1170	}
		1171
		1172	=back
		1173
		1174	=head3 MESSAGE LOGGING
		1175
		1176	These methods allow you to log messages directly to a context, without
		1177	going via your package context.
		1178
		1179	=over 4
		1180
783	=item $ctx->log ($level, $msg[, @params])	1181	=item $ctx->log ($level, $msg[, @params])
784		1182
785	Same as C<AnyEvent::Log::log>, but uses the given context as log context.	1183	Same as C<AnyEvent::Log::log>, but uses the given context as log context.
		1184
		1185	Example: log a message in the context of another package.
		1186
		1187	(AnyEvent::Log::ctx "Other::Package")->log (warn => "heely bo");
786		1188
787	=item $logger = $ctx->logger ($level[, \$enabled])	1189	=item $logger = $ctx->logger ($level[, \$enabled])
788		1190
789	Same as C<AnyEvent::Log::logger>, but uses the given context as log	1191	Same as C<AnyEvent::Log::logger>, but uses the given context as log
790	context.	1192	context.
…		…
792	=cut	1194	=cut
793		1195
794	*log = \&AnyEvent::Log::_log;	1196	*log = \&AnyEvent::Log::_log;
795	*logger = \&AnyEvent::Log::_logger;	1197	*logger = \&AnyEvent::Log::_logger;
796		1198
797	1;
798
799	=back	1199	=back
800		1200
		1201	=cut
		1202
		1203	package AnyEvent::Log;
		1204
		1205	=head1 CONFIGURATION VIA $ENV{PERL_ANYEVENT_LOG}
		1206
		1207	Logging can also be configured by setting the environment variable
		1208	C<PERL_ANYEVENT_LOG> (or C<AE_LOG>).
		1209
		1210	The value consists of one or more logging context specifications separated
		1211	by C<:> or whitespace. Each logging specification in turn starts with a
		1212	context name, followed by C<=>, followed by zero or more comma-separated
		1213	configuration directives, here are some examples:
		1214
		1215	# set default logging level
		1216	filter=warn
		1217
		1218	# log to file instead of to stderr
		1219	log=file=/tmp/mylog
		1220
		1221	# log to file in addition to stderr
		1222	log=+%file:%file=file=/tmp/mylog
		1223
		1224	# enable debug log messages, log warnings and above to syslog
		1225	filter=debug:log=+%warnings:%warnings=warn,syslog=LOG_LOCAL0
		1226
		1227	# log trace messages (only) from AnyEvent::Debug to file
		1228	AnyEvent::Debug=+%trace:%trace=only,trace,file=/tmp/tracelog
		1229
		1230	A context name in the log specification can be any of the following:
		1231
		1232	=over 4
		1233
		1234	=item C<collect>, C<filter>, C<log>
		1235
		1236	Correspond to the three predefined C<$AnyEvent::Log::COLLECT>,
		1237	C<AnyEvent::Log::FILTER> and C<$AnyEvent::Log::LOG> contexts.
		1238
		1239	=item C<%name>
		1240
		1241	Context names starting with a C<%> are anonymous contexts created when the
		1242	name is first mentioned. The difference to package contexts is that by
		1243	default they have no attached slaves.
		1244
		1245	This makes it possible to create new log contexts that can be refered to
		1246	multiple times by name within the same log specification.
		1247
		1248	=item a perl package name
		1249
		1250	Any other string references the logging context associated with the given
		1251	Perl C<package>. In the unlikely case where you want to specify a package
		1252	context that matches on of the other context name forms, you can add a
		1253	C<::> to the package name to force interpretation as a package.
		1254
		1255	=back
		1256
		1257	The configuration specifications can be any number of the following:
		1258
		1259	=over 4
		1260
		1261	=item C<stderr>
		1262
		1263	Configures the context to use Perl's C<warn> function (which typically
		1264	logs to C<STDERR>). Works like C<log_to_warn>.
		1265
		1266	=item C<file=>I<path>
		1267
		1268	Configures the context to log to a file with the given path. Works like
		1269	C<log_to_file>.
		1270
		1271	=item C<path=>I<path>
		1272
		1273	Configures the context to log to a file with the given path. Works like
		1274	C<log_to_path>.
		1275
		1276	=item C<syslog> or C<syslog=>I<expr>
		1277
		1278	Configures the context to log to syslog. If I<expr> is given, then it is
		1279	evaluated in the L<Sys::Syslog> package, so you could use:
		1280
		1281	log=syslog=LOG_LOCAL0
		1282
		1283	=item C<nolog>
		1284
		1285	Configures the context to not log anything by itself, which is the
		1286	default. Same as C<< $ctx->log_cb (undef) >>.
		1287
		1288	=item C<cap=>I<level>
		1289
		1290	Caps logging messages entering this context at the given level, i.e.
		1291	reduces the priority of messages with higher priority than this level. The
		1292	default is C<0> (or C<off>), meaning the priority will not be touched.
		1293
		1294	=item C<0> or C<off>
		1295
		1296	Sets the logging level of the context to C<0>, i.e. all messages will be
		1297	filtered out.
		1298
		1299	=item C<all>
		1300
		1301	Enables all logging levels, i.e. filtering will effectively be switched
		1302	off (the default).
		1303
		1304	=item C<only>
		1305
		1306	Disables all logging levels, and changes the interpretation of following
		1307	level specifications to enable the specified level only.
		1308
		1309	Example: only enable debug messages for a context.
		1310
		1311	context=only,debug
		1312
		1313	=item C<except>
		1314
		1315	Enables all logging levels, and changes the interpretation of following
		1316	level specifications to disable that level. Rarely used.
		1317
		1318	Example: enable all logging levels except fatal and trace (this is rather
		1319	nonsensical).
		1320
		1321	filter=exept,fatal,trace
		1322
		1323	=item C<level>
		1324
		1325	Enables all logging levels, and changes the interpretation of following
		1326	level specifications to be "that level or any higher priority
		1327	message". This is the default.
		1328
		1329	Example: log anything at or above warn level.
		1330
		1331	filter=warn
		1332
		1333	# or, more verbose
		1334	filter=only,level,warn
		1335
		1336	=item C<1>..C<9> or a logging level name (C<error>, C<debug> etc.)
		1337
		1338	A numeric loglevel or the name of a loglevel will be interpreted according
		1339	to the most recent C<only>, C<except> or C<level> directive. By default,
		1340	specifying a logging level enables that and any higher priority messages.
		1341
		1342	=item C<+>I<context>
		1343
		1344	Attaches the named context as slave to the context.
		1345
		1346	=item C<+>
		1347
		1348	A lone C<+> detaches all contexts, i.e. clears the slave list from the
		1349	context. Anonymous (C<%name>) contexts have no attached slaves by default,
		1350	but package contexts have the parent context as slave by default.
		1351
		1352	Example: log messages from My::Module to a file, do not send them to the
		1353	default log collector.
		1354
		1355	My::Module=+,file=/tmp/mymodulelog
		1356
		1357	=back
		1358
		1359	Any character can be escaped by prefixing it with a C<\> (backslash), as
		1360	usual, so to log to a file containing a comma, colon, backslash and some
		1361	spaces in the filename, you would do this:
		1362
		1363	PERL_ANYEVENT_LOG='log=file=/some\ \:file\ with\,\ \\-escapes'
		1364
		1365	Since whitespace (which includes newlines) is allowed, it is fine to
		1366	specify multiple lines in C<PERL_ANYEVENT_LOG>, e.g.:
		1367
		1368	PERL_ANYEVENT_LOG="
		1369	filter=warn
		1370	AnyEvent::Debug=+%trace
		1371	%trace=only,trace,+log
		1372	" myprog
		1373
		1374	Also, in the unlikely case when you want to concatenate specifications,
		1375	use whitespace as separator, as C<::> will be interpreted as part of a
		1376	module name, an empty spec with two separators:
		1377
		1378	PERL_ANYEVENT_LOG="$PERL_ANYEVENT_LOG MyMod=debug"
		1379
		1380	=cut
		1381
		1382	for (my $spec = $ENV{PERL_ANYEVENT_LOG}) {
		1383	my %anon;
		1384
		1385	my $pkg = sub {
		1386	$_[0] eq "log" ? $LOG
		1387	: $_[0] eq "filter" ? $FILTER
		1388	: $_[0] eq "collect" ? $COLLECT
		1389	: $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= do { my $ctx = ctx undef; $ctx->[0] = $_[0]; $ctx })
		1390	: $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/
		1391	: die # never reached?
		1392	};
		1393
		1394	/\G[[:space:]]+/gc; # skip initial whitespace
		1395
		1396	while (/\G((?:[^:=[:space:]]+|::|\\.)+)=/gc) {
		1397	my $ctx = $pkg->($1);
		1398	my $level = "level";
		1399
		1400	while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
		1401	for ("$1") {
		1402	if ($_ eq "stderr" ) { $ctx->log_to_warn;
		1403	} elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1");
		1404	} elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1");
		1405	} elsif (/^syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ("$1");
		1406	} elsif ($_ eq "nolog" ) { $ctx->log_cb (undef);
		1407	} elsif (/^cap=(.+)/ ) { $ctx->cap ("$1");
		1408	} elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1"));
		1409	} elsif ($_ eq "+" ) { $ctx->slaves;
		1410	} elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
		1411	} elsif ($_ eq "all" ) { $ctx->level ("all");
		1412	} elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level";
		1413	} elsif ($_ eq "only" ) { $ctx->level ("off"); $level = "enable";
		1414	} elsif ($_ eq "except" ) { $ctx->level ("all"); $level = "disable";
		1415	} elsif (/^\d$/ ) { $ctx->$level ($_);
		1416	} elsif (exists $STR2LEVEL{$_} ) { $ctx->$level ($_);
		1417	} else { die "PERL_ANYEVENT_LOG ($spec): parse error at '$_'\n";
		1418	}
		1419	}
		1420
		1421	/\G,/gc or last;
		1422	}
		1423
		1424	/\G[:[:space:]]+/gc or last;
		1425	}
		1426
		1427	/\G[[:space:]]+/gc; # skip trailing whitespace
		1428
		1429	if (/\G(.+)/g) {
		1430	die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n";
		1431	}
		1432	}
		1433
801	=head1 EXAMPLES	1434	=head1 EXAMPLES
802		1435
803	This section shows some common configurations.	1436	This section shows some common configurations, both as code, and as
		1437	C<PERL_ANYEVENT_LOG> string.
804		1438
805	=over 4	1439	=over 4
806		1440
807	=item Setting the global logging level.	1441	=item Setting the global logging level.
808		1442
809	Either put PERL_ANYEVENT_VERBOSE=<number> into your environment before	1443	Either put C<PERL_ANYEVENT_VERBOSE=><number> into your environment before
810	running your program, or modify the log level of the root context:	1444	running your program, use C<PERL_ANYEVENT_LOG> or modify the log level of
		1445	the root context at runtime:
811		1446
812	PERL_ANYEVENT_VERBOSE=5 ./myprog	1447	PERL_ANYEVENT_VERBOSE=5 ./myprog
813		1448
		1449	PERL_ANYEVENT_LOG=log=warn
		1450
814	$AnyEvent::Log::Root->level ("warn");	1451	$AnyEvent::Log::FILTER->level ("warn");
815		1452
816	=item Append all messages to a file instead of sending them to STDERR.	1453	=item Append all messages to a file instead of sending them to STDERR.
817		1454
818	This is affected by the global logging level.	1455	This is affected by the global logging level.
819		1456
820	open my $fh, ">>", $path	1457	$AnyEvent::Log::LOG->log_to_file ($path);
821	or die "$path: $!";
822		1458
823	$AnyEvent::Log::Default->log_cb (sub {	1459	PERL_ANYEVENT_LOG=log=file=/some/path
824	syswrite $fh, shift;
825	0
826	});
827		1460
828	=item Write all messages with priority C<error> and higher to a file.	1461	=item Write all messages with priority C<error> and higher to a file.
829		1462
830	This writes them only when the global logging level allows it, because	1463	This writes them only when the global logging level allows it, because
831	it is attached to the default context which is invoked I<after> global	1464	it is attached to the default context which is invoked I<after> global
832	filtering.	1465	filtering.
833		1466
834	open my $fh, ">>", $path	1467	$AnyEvent::Log::FILTER->attach (
835	or die "$path: $!";	1468	new AnyEvent::Log::Ctx log_to_file => $path);
836		1469
837	$AnyEvent::Log::Default->attach (new AnyEvent::Log::Ctx	1470	PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
838	log_cb => sub { syswrite $fh, shift; 0 });
839		1471
840	This writes them regardless of the global logging level, because it is	1472	This writes them regardless of the global logging level, because it is
841	attached to the toplevel context, which receives all messages I<before>	1473	attached to the toplevel context, which receives all messages I<before>
842	the global filtering.	1474	the global filtering.
843		1475
844	$AnyEvent::Log::Top->attach (new AnyEvent::Log::Ctx	1476	$AnyEvent::Log::COLLECT->attach (
845	log_cb => sub { syswrite $fh, shift; 0 });	1477	new AnyEvent::Log::Ctx log_to_file => $path);
846		1478
		1479	PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
		1480
847	In both cases, messages are still written to STDOUT.	1481	In both cases, messages are still written to STDERR.
		1482
		1483	=item Additionally log all messages with C<warn> and higher priority to
		1484	C<syslog>, but cap at C<error>.
		1485
		1486	This logs all messages to the default log target, but also logs messages
		1487	with priority C<warn> or higher (and not filtered otherwise) to syslog
		1488	facility C<user>. Messages with priority higher than C<error> will be
		1489	logged with level C<error>.
		1490
		1491	$AnyEvent::Log::LOG->attach (
		1492	new AnyEvent::Log::Ctx
		1493	level => "warn",
		1494	cap => "error",
		1495	syslog => "user",
		1496	);
		1497
		1498	PERL_ANYEVENT_LOG=log=+%syslog:%syslog=warn,cap=error,syslog
848		1499
849	=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).	1500	=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
850		1501
851	Attach the CyAnyEvent::Log::Default> context to the C<AnyEvent::Debug>	1502	Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
852	context and increase the C<AnyEvent::Debug> logging level - this simply
853	circumvents the global filtering for trace messages.	1503	context - this simply circumvents the global filtering for trace messages.
854		1504
855	my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;	1505	my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
856	$debug->attach ($AnyEvent::Log::Default);	1506	$debug->attach ($AnyEvent::Log::LOG);
857	$debug->levels ("trace"); # not "level"!
858		1507
859	This of course works for any package.	1508	PERL_ANYEVENT_LOG=AnyEvent::Debug=+log
		1509
		1510	This of course works for any package, not just L<AnyEvent::Debug>, but
		1511	assumes the log level for AnyEvent::Debug hasn't been changed from the
		1512	default.
860		1513
861	=back	1514	=back
862		1515
		1516	=head1 ASYNCHRONOUS DISK I/O
		1517
		1518	This module uses L<AnyEvent::IO> to actually write log messages (in
		1519	C<log_to_file> and C<log_to_path>), so it doesn't block your program when
		1520	the disk is busy and a non-blocking L<AnyEvent::IO> backend is available.
		1521
863	=head1 AUTHOR	1522	=head1 AUTHOR
864		1523
865	Marc Lehmann <schmorp@schmorp.de>	1524	Marc Lehmann <schmorp@schmorp.de>
866	http://home.schmorp.de/	1525	http://anyevent.schmorp.de
867		1526
868	=cut	1527	=cut
		1528
		1529	1
		1530

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines