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.8 by root, Fri Aug 19 19:20:36 2011 UTC vs.
Revision 1.72 by root, Wed Feb 9 00:28:21 2022 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	#TODO: config	43	Configuration (also look at the EXAMPLES section):
24	#TODO: ctx () becomes caller[0]...	44
		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
		51	AnyEvent::Log::ctx->level ("error");
		52
		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
		57	(AnyEvent::Log::ctx "some::mod")->level ("debug");
		58	(AnyEvent::Log::ctx "some::mod")->attach ($AnyEvent::Log::LOG);
		59
		60	# send all critical and higher priority messages to syslog,
		61	# regardless of (most) other settings
		62	$AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx
		63	level => "critical",
		64	log_to_syslog => "user",
		65	);
25		66
26	=head1 DESCRIPTION	67	=head1 DESCRIPTION
27		68
28	This module implements a relatively simple "logging framework". It doesn't	69	This module implements a relatively simple "logging framework". It doesn't
29	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
30	AnyEvent - AnyEvent simply creates logging messages internally, and this	71	AnyEvent - AnyEvent simply creates logging messages internally, and this
31	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
32	using it from other modules as well.	73	using it from other modules as well.
33		74
34	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
35	logged, ever, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number	76	errors and more important messages will be logged, unless you set
36	before starting your program.#TODO	77	C<PERL_ANYEVENT_VERBOSE> to a higher number before starting your program
		78	(C<AE_VERBOSE=5> is recommended during development), or change the logging
		79	level at runtime with something like:
37		80
38	Possible future extensions are to allow custom log targets (where the	81	use AnyEvent::Log;
39	level is an object), log filtering based on package, formatting, aliasing	82	$AnyEvent::Log::FILTER->level ("info");
40	or package groups.
41		83
		84	The design goal behind this module was to keep it simple (and small),
		85	but make it powerful enough to be potentially useful for any module,
		86	and extensive enough for the most common tasks, such as logging to
		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 document them.
		136
42	=head1 LOG FUNCTIONS	137	=head1 LOGGING FUNCTIONS
43		138
44	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
45	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,
46	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>
47	loaded.	142	module is loaded.
48		143
49	=over 4	144	=over 4
50		145
51	=cut	146	=cut
52		147
53	package AnyEvent::Log;	148	package AnyEvent::Log;
54		149
55	use Carp ();	150	use Carp ();
56	use POSIX ();	151	use POSIX ();
57		152
		153	# layout of a context
		154	# 0 1 2 3 4, 5
		155	# [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap]
		156
58	use AnyEvent (); BEGIN { AnyEvent::common_sense }	157	use AnyEvent (); BEGIN { AnyEvent::common_sense }
59	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);
60		163
61	our ($now_int, $now_str1, $now_str2);	164	our ($now_int, $now_str1, $now_str2);
62		165
63	# Format Time, not public - yet?	166	# Format Time, not public - yet?
64	sub ft($) {	167	sub format_time($) {
65	my $i = int $_[0];	168	my $i = int $_[0];
66	my $f = sprintf "%06d", 1e6 * ($_[0] - $i);	169	my $f = sprintf "%06d", 1e6 * ($_[0] - $i);
67		170
68	($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)
69	if $now_int != $i;	172	if $now_int != $i;
70		173
71	"$now_str1$f$now_str2"	174	"$now_str1$f$now_str2"
72	}	175	}
73		176
74	our %CTX; # all logging contexts	177	our %CTX; # all package contexts
75
76	my $default_log_cb = sub { 0 };
77		178
78	# creates a default package context object for the given package	179	# creates a default package context object for the given package
79	sub _pkg_ctx($) {	180	sub _pkg_ctx($) {
80	my $ctx = bless [$_[0], 0, {}, $default_log_cb], "AnyEvent::Log::Ctx";	181	my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx";
81		182
82	# link "parent" package	183	# link "parent" package
83	my $pkg = $_[0] =~ /^(.+)::/ ? $1 : "";	184	my $parent = $_[0] =~ /^(.+)::/
		185	? $CTX{$1} ||= &_pkg_ctx ("$1")
		186	: $COLLECT;
84		187
85	$pkg = $CTX{$pkg} ||= &_pkg_ctx ($pkg);
86	$ctx->[2]{$pkg+0} = $pkg;	188	$ctx->[2]{$parent+0} = $parent;
87		189
88	$ctx	190	$ctx
89	}	191	}
90		192
91	=item AnyEvent::Log::log $level, $msg[, @args]	193	=item AnyEvent::Log::log $level, $msg[, @args]
92		194
93	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
94	You can also use the following strings as log level: C<fatal> (1),	196	returns true if the message was logged I<somewhere>.
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		197
98	For C<fatal> log levels, the program will abort.	198	For loglevel C<fatal>, the program will abort.
99		199
100	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
101	C<$msg> is interpreted as an sprintf format string.	201	C<$msg> is interpreted as an sprintf format string.
102		202
103	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
…		…
106	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
107	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
108	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
109	message in the first place.	209	message in the first place.
110		210
		211	This function takes care of saving and restoring C<$!> and C<$@>, so you
		212	don't have to.
		213
111	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
112	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.
113		219
114	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
115	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
116	need any additional functionality), as those functions will load the	222	need any additional functionality), as those functions will load the
117	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.
118		224
119	Also, if you otpionally generate a lot of debug messages (such as when	225	Also, if you optionally generate a lot of debug messages (such as when
120	tracing some code), you should look into using a logger callback and a	226	tracing some code), you should look into using a logger callback and a
121	boolean enabler (see C<logger>, below).	227	boolean enabler (see C<logger>, below).
122		228
123	Example: log something at error level.	229	Example: log something at error level.
124		230
…		…
134		240
135	=cut	241	=cut
136		242
137	# also allow syslog equivalent names	243	# also allow syslog equivalent names
138	our %STR2LEVEL = (	244	our %STR2LEVEL = (
139	fatal => 1, emerg => 1,	245	fatal => 1, emerg => 1, exit => 1,
140	alert => 2,	246	alert => 2,
141	critical => 3, crit => 3,	247	critical => 3, crit => 3,
142	error => 4, err => 4,	248	error => 4, err => 4, die => 4,
143	warn => 5, warning => 5,	249	warn => 5, warning => 5,
144	note => 6, notice => 6,	250	note => 6, notice => 6,
145	info => 7,	251	info => 7,
146	debug => 8,	252	debug => 8,
147	trace => 9,	253	trace => 9,
148	);	254	);
149		255
150	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	}
		268
151	AnyEvent::post_detect {	269	AnyEvent::post_detect {
152	*now = \&AE::now;	270	exact_time $TIME_EXACT;
153	};	271	};
154		272
155	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);
156		274
157	# time, ctx, level, msg	275	# time, ctx, level, msg
158	sub _format($$$$) {	276	sub default_format($$$$) {
159	my $pfx = ft $_[0];	277	my $ts = format_time $_[0];
		278	my $ct = " ";
160		279
161	join "",	280	my @res;
162	map "$pfx $_\n",	281
163	split /\n/,
164	sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]	282	for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) {
		283	push @res, "$ts$ct$_\n";
		284	$ct = " + ";
		285	}
		286
		287	join "", @res
		288	}
		289
		290	sub fatal_exit() {
		291	exit 1;
165	}	292	}
166		293
167	sub _log {	294	sub _log {
168	my ($ctx, $level, $format, @args) = @_;	295	my ($ctx, $level, $format, @args) = @_;
169		296
		297	$level = $level > 0 && $level <= 9
		298	? $level+0
170	$level = $level > 0 && $level <= 9 ? $level+0 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";	299	: $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
171		300
172	my $mask = 1 << $level;	301	my $mask = 1 << $level;
173	my $now = AE::now;
174		302
175	my (@ctx, $did_format, $fmt);	303	my ($success, %seen, @ctx, $now, @fmt);
176		304
177	do {	305	do
178	if ($ctx->[1] & $mask) {	306	{
		307	# if !ref, then it's a level number
		308	if (!ref $ctx) {
		309	$level = $ctx;
		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
		320	if ($ctx->[3]) {
179	# logging target found	321	# logging target found
180		322
181	# get raw message	323	local ($!, $@);
182	unless ($did_format) {	324
		325	# now get raw message, unless we have it already
		326	unless ($now) {
183	$format = $format->() if ref $format;	327	$format = $format->() if ref $format;
184	$format = sprintf $format, @args if @args;	328	$format = sprintf $format, @args if @args;
185	$format =~ s/\n$//;	329	$format =~ s/\n$//;
186	$did_format = 1;	330	$now = _ts;
		331	};
		332
		333	# format msg
		334	my $str = $ctx->[4]
		335	? $ctx->[4]($now, $_[0], $level, $format)
		336	: ($fmt[$level] ||= default_format $now, $_[0], $level, $format);
		337
		338	$success = 1;
		339
		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
		344	}
187	};	345	}
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	}	346	}
197
198	# not consume - push parent contexts
199	push @ctx, values %{ $ctx->[2] };
200	} while $ctx = pop @ctx;	347	while $ctx = pop @ctx;
201		348
202	exit 1 if $level <= 1;	349	fatal_exit if $level <= 1;
		350
		351	$success
203	}	352	}
204		353
205	sub log($$;@) {	354	sub log($$;@) {
206	_log	355	_log
207	$CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],	356	$CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
208	@_;	357	@_;
209	}	358	}
210		359
211	*AnyEvent::log = *AE::log = \&log;
212
213	=item $logger = AnyEvent::Log::logger $level[, \$enabled]	360	=item $logger = AnyEvent::Log::logger $level[, \$enabled]
214		361
215	Creates a code reference that, when called, acts as if the	362	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	363	C<AnyEvent::Log::log> function was called at this point with the given
217	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
218	the C<AnyEvent::Log::log> function:	365	the C<AnyEvent::Log::log> function:
219		366
220	my $debug_log = AnyEvent::Log::logger "debug";	367	my $debug_log = AnyEvent::Log::logger "debug";
221		368
…		…
246	# and later in your program	393	# and later in your program
247	$debug_log->("yo, stuff here") if $debug;	394	$debug_log->("yo, stuff here") if $debug;
248		395
249	$debug and $debug_log->("123");	396	$debug and $debug_log->("123");
250		397
251	Note: currently the enabled var is always true - that will be fixed in a
252	future version :)
253
254	=cut	398	=cut
255		399
256	our %LOGGER;	400	our %LOGGER;
257		401
258	# re-assess logging status for all loggers	402	# re-assess logging status for all loggers
259	sub _reassess {	403	sub _reassess {
		404	local $SIG{__DIE__};
		405	my $die = sub { die };
		406
260	for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {	407	for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
261	my ($ctx, $level, $renabled) = @$_;	408	my ($ctx, $level, $renabled) = @$_;
262		409
263	# to detetc whether a message would be logged, we # actually	410	# to detect whether a message would be logged, we actually
264	# 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
265	# sure that the logging decision is correct :)	412	# sure that the logging decision is correct :)
266		413
267	$$renabled = !eval {	414	$$renabled = !eval {
268	local $SIG{__DIE__};
269
270	_log $ctx, $level, sub { die };	415	_log $ctx, $level, $die;
271		416
272	1	417	1
273	};	418	};
274
275	$$renabled = 1; # TODO
276	}	419	}
277	}	420	}
278		421
279	sub _logger($;$) {	422	sub _logger {
280	my ($ctx, $level, $renabled) = @_;	423	my ($ctx, $level, $renabled) = @_;
281		424
282	$renabled ||= \my $enabled;
283
284	$$renabled = 1;	425	$$renabled = 1;
285		426
286	my $logger = [$ctx, $level, $renabled];	427	my $logger = [$ctx, $level, $renabled];
287		428
288	$LOGGER{$logger+0} = $logger;	429	$LOGGER{$logger+0} = $logger;
289		430
290	_reassess $logger+0;	431	_reassess $logger+0;
291		432
		433	require AnyEvent::Util unless $AnyEvent::Util::VERSION;
292	my $guard = AnyEvent::Util::guard {	434	my $guard = AnyEvent::Util::guard (sub {
293	# "clean up"	435	# "clean up"
294	delete $LOGGER{$logger+0};	436	delete $LOGGER{$logger+0};
295	};	437	});
296		438
297	sub {	439	sub {
298	$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
299		441
300	_log $ctx, $level, @_	442	_log $ctx, $level, @_
…		…
306	_logger	448	_logger
307	$CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],	449	$CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
308	@_	450	@_
309	}	451	}
310		452
311	#TODO	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 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.
312		502
313	=back	503	=back
314		504
315	=head1 CONFIGURATION FUNCTIONALITY	505	=head1 LOGGING CONTEXTS
316		506
317	None, yet, except for C<PERL_ANYEVENT_VERBOSE>, described in the L<AnyEvent> manpage.	507	This module associates every log message with a so-called I<logging
		508	context>, based on the package of the caller. Every perl package has its
		509	own logging context.
318		510
319	#TODO: wahst a context	511	A logging context has three major responsibilities: filtering, logging and
320	#TODO	512	propagating the message.
		513
		514	For the first purpose, filtering, each context has a set of logging
		515	levels, called the log level mask. Messages not in the set will be ignored
		516	by this context (masked).
		517
		518	For logging, the context stores a formatting callback (which takes the
		519	timestamp, context, level and string message and formats it in the way
		520	it should be logged) and a logging callback (which is responsible for
		521	actually logging the formatted message and telling C<AnyEvent::Log>
		522	whether it has consumed the message, or whether it should be propagated).
		523
		524	For propagation, a context can have any number of attached I<slave
		525	contexts>. Any message that is neither masked by the logging mask nor
		526	masked by the logging callback returning true will be passed to all slave
		527	contexts.
		528
		529	Each call to a logging function will log the message at most once per
		530	context, so it does not matter (much) if there are cycles or if the
		531	message can arrive at the same context via multiple paths.
		532
		533	=head2 DEFAULTS
		534
		535	By default, all logging contexts have an full set of log levels ("all"), a
		536	disabled logging callback and the default formatting callback.
		537
		538	Package contexts have the package name as logging title by default.
		539
		540	They have exactly one slave - the context of the "parent" package. The
		541	parent package is simply defined to be the package name without the last
		542	component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>,
		543	and C<AnyEvent> becomes ... C<$AnyEvent::Log::COLLECT> which is the
		544	exception of the rule - just like the "parent" of any single-component
		545	package name in Perl is C<main>, the default slave of any top-level
		546	package context is C<$AnyEvent::Log::COLLECT>.
		547
		548	Since perl packages form only an approximate hierarchy, this slave
		549	context can of course be removed.
		550
		551	All other (anonymous) contexts have no slaves and an empty title by
		552	default.
		553
		554	When the module is loaded it creates the C<$AnyEvent::Log::LOG> logging
		555	context that simply logs everything via C<warn>, without propagating
		556	anything anywhere by default. The purpose of this context is to provide
		557	a convenient place to override the global logging target or to attach
		558	additional log targets. It's not meant for filtering.
		559
		560	It then creates the C<$AnyEvent::Log::FILTER> context whose
		561	purpose is to suppress all messages with priority higher
		562	than C<$ENV{PERL_ANYEVENT_VERBOSE}>. It then attached the
		563	C<$AnyEvent::Log::LOG> context to it. The purpose of the filter context
		564	is to simply provide filtering according to some global log level.
		565
		566	Finally it creates the top-level package context C<$AnyEvent::Log::COLLECT>
		567	and attaches the C<$AnyEvent::Log::FILTER> context to it, but otherwise
		568	leaves it at default config. Its purpose is simply to collect all log
		569	messages system-wide.
		570
		571	The hierarchy is then:
		572
		573	any package, eventually -> $COLLECT -> $FILTER -> $LOG
		574
		575	The effect of all this is that log messages, by default, wander up to the
		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
		578	priority then C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered out and then
		579	to the C<$AnyEvent::Log::LOG> context to be passed to C<warn>.
		580
		581	This makes it easy to set a global logging level (by modifying $FILTER),
		582	but still allow other contexts to send, for example, their debug and trace
		583	messages to the $LOG target despite the global logging level, or to attach
		584	additional log targets that log messages, regardless of the global logging
		585	level.
		586
		587	It also makes it easy to modify the default warn-logger ($LOG) to
		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.
		590
		591	=head2 CREATING/FINDING/DESTROYING CONTEXTS
321		592
322	=over 4	593	=over 4
323		594
324	=item $ctx = AnyEvent::Log::ctx [$pkg]	595	=item $ctx = AnyEvent::Log::ctx [$pkg]
325		596
326	Returns a I<config> object for the given package name.	597	This function creates or returns a logging context (which is an object).
327		598
328	If no package name is given, returns the context for the current perl	599	If a package name is given, then the context for that package is
		600	returned. If it is called without any arguments, then the context for the
329	package (i.e. the same context as a C<AE::log> call would use).	601	callers package is returned (i.e. the same context as a C<AE::log> call
		602	would use).
330		603
331	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
332	tied to any package and is destroyed when no longer referenced.	605	tied to any package and is destroyed when no longer referenced.
333		606
334	=cut	607	=cut
…		…
338		611
339	ref $pkg	612	ref $pkg
340	? $pkg	613	? $pkg
341	: defined $pkg	614	: defined $pkg
342	? $CTX{$pkg} ||= AnyEvent::Log::_pkg_ctx $pkg	615	? $CTX{$pkg} ||= AnyEvent::Log::_pkg_ctx $pkg
343	: bless [undef, 0, undef, $default_log_cb], "AnyEvent::Log::Ctx"	616	: bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx"
344	}	617	}
345		618
346	# create default root context	619	=item AnyEvent::Log::reset
347	{	620
348	my $root = ctx undef;	621	Resets all package contexts and recreates the default hierarchy if
349	$root->[0] = "";	622	necessary, i.e. resets the logging subsystem to defaults, as much as
350	$root->title ("default");	623	possible. This process keeps references to contexts held by other parts of
351	$root->level ($AnyEvent::VERBOSE);	624	the program intact.
352	$root->log_cb (sub {	625
353	print STDERR shift;	626	This can be used to implement config-file (re-)loading: before loading a
354	0	627	configuration, reset all contexts.
		628
		629	=cut
		630
		631	our $ORIG_VERBOSE = $AnyEvent::VERBOSE;
		632	$AnyEvent::VERBOSE = 9;
		633
		634	sub reset {
		635	# hard to kill complex data structures
		636	# we "recreate" all package loggers and reset the hierarchy
		637	while (my ($k, $v) = each %CTX) {
		638	@$v = ($k, (1 << 10) - 1 - 1, { });
		639
		640	$v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log::COLLECT);
355	});	641	}
356	$CTX{""} = $root;	642
		643	@$_ = ($_->[0], (1 << 10) - 1 - 1)
		644	for $LOG, $FILTER, $COLLECT;
		645
		646	#$LOG->slaves;
		647	$LOG->title ('$AnyEvent::Log::LOG');
		648	$LOG->log_to_warn;
		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;
357	}	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;
		672
		673	AnyEvent::Log::reset;
		674
		675	# hello, CPAN, please catch me
		676	package AnyEvent::Log::LOG;
		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;
358		682
359	package AnyEvent::Log::Ctx;	683	package AnyEvent::Log::Ctx;
360		684
361	# 0 1 2 3 4	685	=item $ctx = new AnyEvent::Log::Ctx methodname => param...
362	# [$title, $level, %$parents, &$logcb, &$fmtcb]	686
		687	This is a convenience constructor that makes it simpler to construct
		688	anonymous logging contexts.
		689
		690	Each key-value pair results in an invocation of the method of the same
		691	name as the key with the value as parameter, unless the value is an
		692	arrayref, in which case it calls the method with the contents of the
		693	array. The methods are called in the same order as specified.
		694
		695	Example: create a new logging context and set both the default logging
		696	level, some slave contexts and a logging callback.
		697
		698	$ctx = new AnyEvent::Log::Ctx
		699	title => "dubious messages",
		700	level => "error",
		701	log_cb => sub { print STDOUT shift; 0 },
		702	slaves => [$ctx1, $ctx, $ctx2],
		703	;
		704
		705	=back
		706
		707	=cut
		708
		709	sub new {
		710	my $class = shift;
		711
		712	my $ctx = AnyEvent::Log::ctx undef;
		713
		714	while (@_) {
		715	my ($k, $v) = splice @_, 0, 2;
		716	$ctx->$k (ref $v eq "ARRAY" ? @$v : $v);
		717	}
		718
		719	bless $ctx, $class # do we really support subclassing, hmm?
		720	}
		721
		722
		723	=head2 CONFIGURING A LOG CONTEXT
		724
		725	The following methods can be used to configure the logging context.
		726
		727	=over 4
363		728
364	=item $ctx->title ([$new_title])	729	=item $ctx->title ([$new_title])
365		730
366	Returns the title of the logging context - this is the package name, for	731	Returns the title of the logging context - this is the package name, for
367	package contexts, and a user defined string for all others.	732	package contexts, and a user defined string for all others.
…		…
373	sub title {	738	sub title {
374	$_[0][0] = $_[1] if @_ > 1;	739	$_[0][0] = $_[1] if @_ > 1;
375	$_[0][0]	740	$_[0][0]
376	}	741	}
377		742
		743	=back
		744
		745	=head3 LOGGING LEVELS
		746
		747	The following methods deal with the logging level set associated with the
		748	log context.
		749
		750	The most common method to use is probably C<< $ctx->level ($level) >>,
		751	which configures the specified and any higher priority levels.
		752
		753	All functions which accept a list of levels also accept the special string
		754	C<all> which expands to all logging levels.
		755
		756	=over 4
		757
378	=item $ctx->levels ($level[, $level...)	758	=item $ctx->levels ($level[, $level...)
379		759
380	Enables logging fot the given levels and disables it for all others.	760	Enables logging for the given levels and disables it for all others.
381		761
382	=item $ctx->level ($level)	762	=item $ctx->level ($level)
383		763
384	Enables logging for the given level and all lower level (higher priority)	764	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	765	ones. In addition to normal logging levels, specifying a level of C<0> or
386	level.	766	C<off> disables all logging for this level.
387		767
388	Example: log warnings, errors and higher priority messages.	768	Example: log warnings, errors and higher priority messages.
389		769
390	$ctx->level ("warn");	770	$ctx->level ("warn");
391	$ctx->level (5); # same thing, just numeric	771	$ctx->level (5); # same thing, just numeric
…		…
396		776
397	=item $ctx->disable ($level[, $level...])	777	=item $ctx->disable ($level[, $level...])
398		778
399	Disables logging for the given levels, leaving all others unchanged.	779	Disables logging for the given levels, leaving all others unchanged.
400		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>.
		802
401	=cut	803	=cut
402		804
403	sub _lvl_lst {	805	sub _lvl_lst {
		806	map {
		807	$_ > 0 && $_ <= 9 ? $_+0
		808	: $_ eq "all" ? (1 .. 9)
404	map { $_ > 0 && $_ <= 9 ? $_+0 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" }	809	: $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
405	@_	810	} @_
		811	}
		812
		813	sub _lvl {
		814	$_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]
406	}	815	}
407		816
408	our $NOP_CB = sub { 0 };	817	our $NOP_CB = sub { 0 };
409		818
410	sub levels {	819	sub levels {
…		…
415	AnyEvent::Log::_reassess;	824	AnyEvent::Log::_reassess;
416	}	825	}
417		826
418	sub level {	827	sub level {
419	my $ctx = shift;	828	my $ctx = shift;
420	my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[0];
421	$ctx->[1] = ((1 << $lvl) - 1) << 1;	829	$ctx->[1] = ((1 << &_lvl) - 1) << 1;
422	AnyEvent::Log::_reassess;	830	AnyEvent::Log::_reassess;
423	}	831	}
424		832
425	sub enable {	833	sub enable {
426	my $ctx = shift;	834	my $ctx = shift;
…		…
434	$ctx->[1] &= ~(1 << $_)	842	$ctx->[1] &= ~(1 << $_)
435	for &_lvl_lst;	843	for &_lvl_lst;
436	AnyEvent::Log::_reassess;	844	AnyEvent::Log::_reassess;
437	}	845	}
438		846
		847	sub cap {
		848	my $ctx = shift;
		849	$ctx->[5] = &_lvl;
		850	}
		851
		852	=back
		853
		854	=head3 SLAVE CONTEXTS
		855
		856	The following methods attach and detach another logging context to a
		857	logging context.
		858
		859	Log messages are propagated to all slave contexts, unless the logging
		860	callback consumes the message.
		861
		862	=over 4
		863
439	=item $ctx->attach ($ctx2[, $ctx3...])	864	=item $ctx->attach ($ctx2[, $ctx3...])
440		865
441	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
442	to add a context twice (the second add will be ignored).	867	to add a context twice (the second add will be ignored).
443		868
444	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.
445		870
446	=item $ctx->detach ($ctx2[, $ctx3...])	871	=item $ctx->detach ($ctx2[, $ctx3...])
447		872
448	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
449	to remove a context that hasn't been added.	874	to remove a context that hasn't been added.
450		875
451	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.
		877
		878	=item $ctx->slaves ($ctx2[, $ctx3...])
		879
		880	Replaces all slaves attached to this context by the ones given.
452		881
453	=cut	882	=cut
454		883
455	sub attach {	884	sub attach {
456	my $ctx = shift;	885	my $ctx = shift;
457		886
458	$ctx->[2]{$_+0} = $_	887	$ctx->[2]{$_+0} = $_
459	for map { AnyEvent::Log::ctx $_ } @_;	888	for map { AnyEvent::Log::ctx $_ } @_;
		889	AnyEvent::Log::_reassess;
460	}	890	}
461		891
462	sub detach {	892	sub detach {
463	my $ctx = shift;	893	my $ctx = shift;
464		894
465	delete $ctx->[2]{$_+0}	895	delete $ctx->[2]{$_+0}
466	for map { AnyEvent::Log::ctx $_ } @_;	896	for map { AnyEvent::Log::ctx $_ } @_;
		897	AnyEvent::Log::_reassess;
467	}	898	}
		899
		900	sub slaves {
		901	undef $_[0][2];
		902	&attach;
		903	AnyEvent::Log::_reassess;
		904	}
		905
		906	=back
		907
		908	=head3 LOG TARGETS
		909
		910	The following methods configure how the logging context actually does
		911	the logging (which consists of formatting the message and printing it or
		912	whatever it wants to do with it).
		913
		914	=over 4
468		915
469	=item $ctx->log_cb ($cb->($str))	916	=item $ctx->log_cb ($cb->($str))
470		917
471	Replaces the logging callback on the context (C<undef> disables the	918	Replaces the logging callback on the context (C<undef> disables the
472	logging callback).	919	logging callback).
…		…
475	(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
476	newline (and are possibly multiline themselves).	923	newline (and are possibly multiline themselves).
477		924
478	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
479	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
480	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.
481		928
482	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
483	and do not consume it.	930	and do not consume it.
484		931
485	$ctx->log_cb (sub { print STDERR shift; 0 });	932	$ctx->log_cb (sub { print STDERR shift; 0 });
486		933
		934	You can filter messages by having a log callback that simply returns C<1>
		935	and does not do anything with the message, but this counts as "message
		936	being logged" and might not be very efficient.
		937
		938	Example: propagate all messages except for log levels "debug" and
		939	"trace". The messages will still be generated, though, which can slow down
		940	your program.
		941
		942	$ctx->levels ("debug", "trace");
		943	$ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
		944
487	=item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message))	945	=item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
488		946
489	Replaces the fornatting callback on the cobntext (C<undef> restores the	947	Replaces the formatting callback on the context (C<undef> restores the
490	default formatter).	948	default formatter).
491		949
492	The callback is passed the (possibly fractional) timestamp, the original	950	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	951	logging context (object, not title), the (numeric) logging level and
494	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
495	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	});
496		973
497	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
498	brackets.	975	brackets.
499		976
500	$ctx->fmt_cb (sub {	977	$ctx->fmt_cb (sub {
…		…
502		979
503	"<$lvl>$msg\n"	980	"<$lvl>$msg\n"
504	});	981	});
505		982
506	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
507	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.
508		985
509	$ctx->fmt_cb (sub { \@_ });	986	$ctx->fmt_cb (sub { \@_ });
510	$ctx->log_cb (sub {	987	$ctx->log_cb (sub {
511	my ($msg) = @_;	988	my ($msg) = @_;
512		989
…		…
517	"$msg->[3]";	994	"$msg->[3]";
518		995
519	0	996	0
520	});	997	});
521		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
522	=cut	1029	=cut
523		1030
524	sub log_cb {	1031	sub log_cb {
525	my ($ctx, $cb) = @_;	1032	my ($ctx, $cb) = @_;
526		1033
527	$ctx->[3] = $cb || $default_log_cb;	1034	$ctx->[3] = $cb;
528	}	1035	}
529		1036
530	sub fmt_cb {	1037	sub fmt_cb {
531	my ($ctx, $cb) = @_;	1038	my ($ctx, $cb) = @_;
532		1039
533	$ctx->[4] = $cb;	1040	$ctx->[4] = $cb;
534	}	1041	}
535		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
536	=item $ctx->log ($level, $msg[, @params])	1181	=item $ctx->log ($level, $msg[, @params])
537		1182
538	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");
539		1188
540	=item $logger = $ctx->logger ($level[, \$enabled])	1189	=item $logger = $ctx->logger ($level[, \$enabled])
541		1190
542	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
543	context.	1192	context.
…		…
545	=cut	1194	=cut
546		1195
547	*log = \&AnyEvent::Log::_log;	1196	*log = \&AnyEvent::Log::_log;
548	*logger = \&AnyEvent::Log::_logger;	1197	*logger = \&AnyEvent::Log::_logger;
549		1198
550	1;
551
552	=back	1199	=back
553		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
		1434	=head1 EXAMPLES
		1435
		1436	This section shows some common configurations, both as code, and as
		1437	C<PERL_ANYEVENT_LOG> string.
		1438
		1439	=over 4
		1440
		1441	=item Setting the global logging level.
		1442
		1443	Either put C<PERL_ANYEVENT_VERBOSE=><number> into your environment before
		1444	running your program, use C<PERL_ANYEVENT_LOG> or modify the log level of
		1445	the root context at runtime:
		1446
		1447	PERL_ANYEVENT_VERBOSE=5 ./myprog
		1448
		1449	PERL_ANYEVENT_LOG=log=warn
		1450
		1451	$AnyEvent::Log::FILTER->level ("warn");
		1452
		1453	=item Append all messages to a file instead of sending them to STDERR.
		1454
		1455	This is affected by the global logging level.
		1456
		1457	$AnyEvent::Log::LOG->log_to_file ($path);
		1458
		1459	PERL_ANYEVENT_LOG=log=file=/some/path
		1460
		1461	=item Write all messages with priority C<error> and higher to a file.
		1462
		1463	This writes them only when the global logging level allows it, because
		1464	it is attached to the default context which is invoked I<after> global
		1465	filtering.
		1466
		1467	$AnyEvent::Log::FILTER->attach (
		1468	new AnyEvent::Log::Ctx log_to_file => $path);
		1469
		1470	PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
		1471
		1472	This writes them regardless of the global logging level, because it is
		1473	attached to the toplevel context, which receives all messages I<before>
		1474	the global filtering.
		1475
		1476	$AnyEvent::Log::COLLECT->attach (
		1477	new AnyEvent::Log::Ctx log_to_file => $path);
		1478
		1479	PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
		1480
		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
		1499
		1500	=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
		1501
		1502	Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
		1503	context - this simply circumvents the global filtering for trace messages.
		1504
		1505	my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
		1506	$debug->attach ($AnyEvent::Log::LOG);
		1507
		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.
		1513
		1514	=back
		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
554	=head1 AUTHOR	1522	=head1 AUTHOR
555		1523
556	Marc Lehmann <schmorp@schmorp.de>	1524	Marc Lehmann <schmorp@schmorp.de>
557	http://home.schmorp.de/	1525	http://anyevent.schmorp.de
558		1526
559	=cut	1527	=cut
		1528
		1529	1
		1530

Diff Legend

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