[ViewVC] Diff of: cvs/AnyEvent/lib/AnyEvent/Log.pm

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents):
Revision 1.18 by root, Sat Aug 20 15:57:35 2011 UTC vs.
Revision 1.73 by root, Sun Apr 24 21:22:38 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	# configuration	43	Configuration (also look at the EXAMPLES section):
		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");
24		49
25	# set logging for the current package to errors and higher only	50	# set logging for the current package to errors and higher only
26	AnyEvent::Log::ctx->level ("error");	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
29	$AnyEvent::Log::FILTER->level ("notice");	54	AnyEvent::Log::ctx->attach ($AnyEvent::Log::LOG);
30		55
31	# see also EXAMPLES, below	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	);
32		66
33	=head1 DESCRIPTION	67	=head1 DESCRIPTION
34		68
35	This module implements a relatively simple "logging framework". It doesn't	69	This module implements a relatively simple "logging framework". It doesn't
36	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
37	AnyEvent - AnyEvent simply creates logging messages internally, and this	71	AnyEvent - AnyEvent simply creates logging messages internally, and this
38	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
39	using it from other modules as well.	73	using it from other modules as well.
40		74
41	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
42	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
43	starting your program, or change the logging level at runtime with	77	C<PERL_ANYEVENT_VERBOSE> to a higher number before starting your program
44	something like:	78	(C<AE_VERBOSE=5> is recommended during development), or change the logging
		79	level at runtime with something like:
45		80
46	use AnyEvent::Log;	81	use AnyEvent::Log;
47	AnyEvent::Log::FILTER->level ("info");	82	$AnyEvent::Log::FILTER->level ("info");
48		83
49	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),
50	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,
51	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
52	targets, or being able to log into a database.	87	multiple targets, or being able to log into a database.
53		88
		89	The module is also usable before AnyEvent itself is initialised, in which
		90	case some of the functionality might be reduced.
		91
54	The amount of documentation might indicate otherwise, but the module is	92	The amount of documentation might indicate otherwise, but the runtime part
55	still just below 300 lines of code.	93	of the module is still just below 300 lines of code.
56		94
57	=head1 LOGGING LEVELS	95	=head1 LOGGING LEVELS
58		96
59	Logging levels in this module range from C<1> (highest priority) to C<9>	97	Logging levels in this module range from C<1> (highest priority) to C<9>
60	(lowest priority). Note that the lowest numerical value is the highest	98	(lowest priority). Note that the lowest numerical value is the highest
…		…
62	numerical value".	100	numerical value".
63		101
64	Instead of specifying levels by name you can also specify them by aliases:	102	Instead of specifying levels by name you can also specify them by aliases:
65		103
66	LVL NAME SYSLOG PERL NOTE	104	LVL NAME SYSLOG PERL NOTE
67	1 fatal emerg exit aborts program!	105	1 fatal emerg exit system unusable, aborts program!
68	2 alert	106	2 alert failure in primary system
69	3 critical crit	107	3 critical crit failure in backup system
70	4 error err die	108	4 error err die non-urgent program errors, a bug
71	5 warn warning	109	5 warn warning possible problem, not necessarily error
72	6 note notice	110	6 note notice unusual conditions
73	7 info	111	7 info normal messages, no action required
74	8 debug	112	8 debug debugging messages for development
75	9 trace	113	9 trace copious tracing output
76		114
77	As you can see, some logging levels have multiple aliases - the first one	115	As you can see, some logging levels have multiple aliases - the first one
78	is the "official" name, the second one the "syslog" name (if it differs)	116	is the "official" name, the second one the "syslog" name (if it differs)
79	and the third one the "perl" name, suggesting that you log C<die> messages	117	and the third one the "perl" name, suggesting (only!) that you log C<die>
80	at C<error> priority.	118	messages at C<error> priority. The NOTE column tries to provide some
		119	rationale on how to chose a logging level.
81		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
82	You can normally only log a single message at highest priority level	126	You can normally only log a message once at highest priority level (C<1>,
83	(C<1>, C<fatal>), because logging a fatal message will also quit the	127	C<fatal>), because logging a fatal message will also quit the program - so
84	program - so use it sparingly :)	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.
85		133
86	Some methods also offer some extra levels, such as C<0>, C<off>, C<none>	134	Some methods also offer some extra levels, such as C<0>, C<off>, C<none>
87	or C<all> - these are only valid in the methods they are documented for.	135	or C<all> - these are only valid for the methods that document them.
88		136
89	=head1 LOGGING FUNCTIONS	137	=head1 LOGGING FUNCTIONS
90		138
91	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
92	package as a "logging context". Also, the main logging function C<log> is	140	caller's package as a "logging context". Also, the main logging function,
93	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>
94	loaded.	142	module is loaded.
95		143
96	=over 4	144	=over 4
97		145
98	=cut	146	=cut
99		147
100	package AnyEvent::Log;	148	package AnyEvent::Log;
101		149
102	use Carp ();	150	use Carp ();
103	use POSIX ();	151	use POSIX ();
104		152
		153	# layout of a context
		154	# 0 1 2 3 4, 5
		155	# [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap]
		156
105	use AnyEvent (); BEGIN { AnyEvent::common_sense }	157	use AnyEvent (); BEGIN { AnyEvent::common_sense }
106	use AnyEvent::Util ();	158	#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log
107		159
108	our $VERSION = $AnyEvent::VERSION;	160	our $VERSION = $AnyEvent::VERSION;
109		161
110	our ($COLLECT, $FILTER, $LOG);	162	our ($COLLECT, $FILTER, $LOG);
111		163
112	our ($now_int, $now_str1, $now_str2);	164	our ($now_int, $now_str1, $now_str2);
113		165
114	# Format Time, not public - yet?	166	# Format Time, not public - yet?
115	sub ft($) {	167	sub format_time($) {
116	my $i = int $_[0];	168	my $i = int $_[0];
117	my $f = sprintf "%06d", 1e6 * ($_[0] - $i);	169	my $f = sprintf "%06d", 1e6 * ($_[0] - $i);
118		170
119	($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)
120	if $now_int != $i;	172	if $now_int != $i;
…		…
138	$ctx	190	$ctx
139	}	191	}
140		192
141	=item AnyEvent::Log::log $level, $msg[, @args]	193	=item AnyEvent::Log::log $level, $msg[, @args]
142		194
143	Requests logging of the given C<$msg> with the given log level.	195	Requests logging of the given C<$msg> with the given log level, and
		196	returns true if the message was logged I<somewhere>.
144		197
145	For C<fatal> log levels, the program will abort.	198	For loglevel C<fatal>, the program will abort.
146		199
147	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
148	C<$msg> is interpreted as an sprintf format string.	201	C<$msg> is interpreted as an sprintf format string.
149		202
150	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
…		…
153	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
154	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
155	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
156	message in the first place.	209	message in the first place.
157		210
		211	This function takes care of saving and restoring C<$!> and C<$@>, so you
		212	don't have to.
		213
158	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
159	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.
160		219
161	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
162	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
163	need any additional functionality), as those functions will load the	222	need any additional functionality), as those functions will load the
164	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.
…		…
192	info => 7,	251	info => 7,
193	debug => 8,	252	debug => 8,
194	trace => 9,	253	trace => 9,
195	);	254	);
196		255
197	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	}
198		268
199	AnyEvent::post_detect {	269	AnyEvent::post_detect {
200	*now = \&AE::now;	270	exact_time $TIME_EXACT;
201	};	271	};
202		272
203	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);
204		274
205	# time, ctx, level, msg	275	# time, ctx, level, msg
206	sub _format($$$$) {	276	sub default_format($$$$) {
207	my $ts = ft $_[0];	277	my $ts = format_time $_[0];
208	my $ct = " ";	278	my $ct = " ";
209		279
210	my @res;	280	my @res;
211		281
212	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]) {
…		…
215	}	285	}
216		286
217	join "", @res	287	join "", @res
218	}	288	}
219		289
		290	sub fatal_exit() {
		291	exit 1;
		292	}
		293
220	sub _log {	294	sub _log {
221	my ($ctx, $level, $format, @args) = @_;	295	my ($ctx, $level, $format, @args) = @_;
222		296
223	$level = $level > 0 && $level <= 9	297	$level = $level > 0 && $level <= 9
224	? $level+0	298	? $level+0
225	: $STR2LEVEL{$level} \|\| Carp::croak "$level: not a valid logging level, caught";	299	: $STR2LEVEL{$level} \|\| Carp::croak "$level: not a valid logging level, caught";
226		300
227	my $mask = 1 << $level;	301	my $mask = 1 << $level;
228		302
229	my (%seen, @ctx, $now, $fmt);	303	my ($success, %seen, @ctx, $now, @fmt);
230		304
231	do	305	do
232	{	306	{
233	# skip if masked	307	# if !ref, then it's a level number
		308	if (!ref $ctx) {
		309	$level = $ctx;
234	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
235	if ($ctx->[3]) {	320	if ($ctx->[3]) {
236	# logging target found	321	# logging target found
		322
		323	local ($!, $@);
237		324
238	# now get raw message, unless we have it already	325	# now get raw message, unless we have it already
239	unless ($now) {	326	unless ($now) {
240	$format = $format->() if ref $format;	327	$format = $format->() if ref $format;
241	$format = sprintf $format, @args if @args;	328	$format = sprintf $format, @args if @args;
242	$format =~ s/\n$//;	329	$format =~ s/\n$//;
243	$now = AE::now;	330	$now = _ts;
244	};	331	};
245		332
246	# format msg	333	# format msg
247	my $str = $ctx->[4]	334	my $str = $ctx->[4]
248	? $ctx->[4]($now, $_[0], $level, $format)	335	? $ctx->[4]($now, $_[0], $level, $format)
249	: $fmt \|\|= _format $now, $_[0], $level, $format;	336	: ($fmt[$level] \|\|= default_format $now, $_[0], $level, $format);
		337
		338	$success = 1;
250		339
251	$ctx->[3]($str)	340	$ctx->[3]($str)
252	or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate	341	or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
253	} else {	342	} else {
254	push @ctx, values %{ $ctx->[2] }; # not masked - propagate	343	push @ctx, values %{ $ctx->[2] }; # not masked - propagate
255	}	344	}
256	}	345	}
257	}	346	}
258	while $ctx = pop @ctx;	347	while $ctx = pop @ctx;
259		348
260	exit 1 if $level <= 1;	349	fatal_exit if $level <= 1;
		350
		351	$success
261	}	352	}
262		353
263	sub log($$;@) {	354	sub log($$;@) {
264	_log	355	_log
265	$CTX{ (caller)[0] } \|\|= _pkg_ctx +(caller)[0],	356	$CTX{ (caller)[0] } \|\|= _pkg_ctx +(caller)[0],
266	@_;	357	@_;
267	}	358	}
268		359
269	AnyEvent::log = AE::log = \&log;
270
271	=item $logger = AnyEvent::Log::logger $level[, \$enabled]	360	=item $logger = AnyEvent::Log::logger $level[, \$enabled]
272		361
273	Creates a code reference that, when called, acts as if the	362	Creates a code reference that, when called, acts as if the
274	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
275	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
276	the C<AnyEvent::Log::log> function:	365	the C<AnyEvent::Log::log> function:
277		366
278	my $debug_log = AnyEvent::Log::logger "debug";	367	my $debug_log = AnyEvent::Log::logger "debug";
279		368
…		…
339		428
340	$LOGGER{$logger+0} = $logger;	429	$LOGGER{$logger+0} = $logger;
341		430
342	_reassess $logger+0;	431	_reassess $logger+0;
343		432
		433	require AnyEvent::Util unless $AnyEvent::Util::VERSION;
344	my $guard = AnyEvent::Util::guard {	434	my $guard = AnyEvent::Util::guard (sub {
345	# "clean up"	435	# "clean up"
346	delete $LOGGER{$logger+0};	436	delete $LOGGER{$logger+0};
347	};	437	});
348		438
349	sub {	439	sub {
350	$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
351		441
352	_log $ctx, $level, @_	442	_log $ctx, $level, @_
…		…
357	sub logger($;$) {	447	sub logger($;$) {
358	_logger	448	_logger
359	$CTX{ (caller)[0] } \|\|= _pkg_ctx +(caller)[0],	449	$CTX{ (caller)[0] } \|\|= _pkg_ctx +(caller)[0],
360	@_	450	@_
361	}	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 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.
362		502
363	=back	503	=back
364		504
365	=head1 LOGGING CONTEXTS	505	=head1 LOGGING CONTEXTS
366		506
…		…
390	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
391	message can arrive at the same context via multiple paths.	531	message can arrive at the same context via multiple paths.
392		532
393	=head2 DEFAULTS	533	=head2 DEFAULTS
394		534
395	By default, all logging contexts have an full set of log levels ("all"), a	535	By default, all logging contexts have a full set of log levels ("all"), a
396	disabled logging callback and the default formatting callback.	536	disabled logging callback and the default formatting callback.
397		537
398	Package contexts have the package name as logging title by default.	538	Package contexts have the package name as logging title by default.
399		539
400	They have exactly one slave - the context of the "parent" package. The	540	They have exactly one slave - the context of the "parent" package. The
…		…
454		594
455	=item $ctx = AnyEvent::Log::ctx [$pkg]	595	=item $ctx = AnyEvent::Log::ctx [$pkg]
456		596
457	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).
458		598
459	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
460	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
461	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
462	would use).	602	would use).
463		603
464	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
…		…
486	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
487	configuration, reset all contexts.	627	configuration, reset all contexts.
488		628
489	=cut	629	=cut
490		630
		631	our $ORIG_VERBOSE = $AnyEvent::VERBOSE;
		632	$AnyEvent::VERBOSE = 9;
		633
491	sub reset {	634	sub reset {
492	# hard to kill complex data structures	635	# hard to kill complex data structures
493	# we recreate all package loggers and reset the hierarchy	636	# we "recreate" all package loggers and reset the hierarchy
494	while (my ($k, $v) = each %CTX) {	637	while (my ($k, $v) = each %CTX) {
495	@$v = ($k, (1 << 10) - 1 - 1, { });	638	@$v = ($k, (1 << 10) - 1 - 1, { });
496		639
497	$v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log);	640	$v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log::COLLECT);
498	}	641	}
499		642
		643	@$_ = ($_->[0], (1 << 10) - 1 - 1)
		644	for $LOG, $FILTER, $COLLECT;
		645
500	$LOG->slaves;	646	#$LOG->slaves;
501	$LOG->title ('$AnyEvent::Log::LOG');	647	$LOG->title ('$AnyEvent::Log::LOG');
502	$LOG->log_cb (sub {	648	$LOG->log_to_warn;
503	warn shift;
504	0
505	});
506		649
507	$FILTER->slaves ($LOG);	650	$FILTER->slaves ($LOG);
508	$FILTER->title ('$AnyEvent::Log::FILTER');	651	$FILTER->title ('$AnyEvent::Log::FILTER');
509	$FILTER->level ($AnyEvent::VERBOSE);	652	$FILTER->level ($ORIG_VERBOSE);
510		653
511	$COLLECT->slaves ($FILTER);	654	$COLLECT->slaves ($FILTER);
512	$COLLECT->title ('$AnyEvent::Log::FILTER');	655	$COLLECT->title ('$AnyEvent::Log::COLLECT');
513		656
514	_reassess;	657	_reassess;
515	}	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;
516		667
517	# create the default logger contexts	668	# create the default logger contexts
518	$LOG = ctx undef;	669	$LOG = ctx undef;
519	$FILTER = ctx undef;	670	$FILTER = ctx undef;
520	$COLLECT = ctx undef;	671	$COLLECT = ctx undef;
…		…
529	package AnyEvent::Log::COLLECT;	680	package AnyEvent::Log::COLLECT;
530	package AE::Log::COLLECT;	681	package AE::Log::COLLECT;
531		682
532	package AnyEvent::Log::Ctx;	683	package AnyEvent::Log::Ctx;
533		684
534	# 0 1 2 3 4
535	# [$title, $level, %$slaves, &$logcb, &$fmtcb]
536
537	=item $ctx = new AnyEvent::Log::Ctx methodname => param...	685	=item $ctx = new AnyEvent::Log::Ctx methodname => param...
538		686
539	This is a convenience constructor that makes it simpler to construct	687	This is a convenience constructor that makes it simpler to construct
540	anonymous logging contexts.	688	anonymous logging contexts.
541		689
…		…
628		776
629	=item $ctx->disable ($level[, $level...])	777	=item $ctx->disable ($level[, $level...])
630		778
631	Disables logging for the given levels, leaving all others unchanged.	779	Disables logging for the given levels, leaving all others unchanged.
632		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
633	=cut	803	=cut
634		804
635	sub _lvl_lst {	805	sub _lvl_lst {
636	map {	806	map {
637	$_ > 0 && $_ <= 9 ? $_+0	807	$_ > 0 && $_ <= 9 ? $_+0
638	: $_ eq "all" ? (1 .. 9)	808	: $_ eq "all" ? (1 .. 9)
639	: $STR2LEVEL{$_} \|\| Carp::croak "$_: not a valid logging level, caught"	809	: $STR2LEVEL{$_} \|\| Carp::croak "$_: not a valid logging level, caught"
640	} @_	810	} @_
641	}	811	}
642		812
		813	sub _lvl {
		814	$_[0] =~ /^(?:0\|off\|none)$/ ? 0 : (_lvl_lst $_[0])[-1]
		815	}
		816
643	our $NOP_CB = sub { 0 };	817	our $NOP_CB = sub { 0 };
644		818
645	sub levels {	819	sub levels {
646	my $ctx = shift;	820	my $ctx = shift;
647	$ctx->[1] = 0;	821	$ctx->[1] = 0;
…		…
650	AnyEvent::Log::_reassess;	824	AnyEvent::Log::_reassess;
651	}	825	}
652		826
653	sub level {	827	sub level {
654	my $ctx = shift;	828	my $ctx = shift;
655	my $lvl = $_[0] =~ /^(?:0\|off\|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
656
657	$ctx->[1] = ((1 << $lvl) - 1) << 1;	829	$ctx->[1] = ((1 << &_lvl) - 1) << 1;
658	AnyEvent::Log::_reassess;	830	AnyEvent::Log::_reassess;
659	}	831	}
660		832
661	sub enable {	833	sub enable {
662	my $ctx = shift;	834	my $ctx = shift;
…		…
670	$ctx->[1] &= ~(1 << $_)	842	$ctx->[1] &= ~(1 << $_)
671	for &_lvl_lst;	843	for &_lvl_lst;
672	AnyEvent::Log::_reassess;	844	AnyEvent::Log::_reassess;
673	}	845	}
674		846
		847	sub cap {
		848	my $ctx = shift;
		849	$ctx->[5] = &_lvl;
		850	}
		851
675	=back	852	=back
676		853
677	=head3 SLAVE CONTEXTS	854	=head3 SLAVE CONTEXTS
678		855
679	The following methods attach and detach another logging context to a	856	The following methods attach and detach another logging context to a
…		…
707	sub attach {	884	sub attach {
708	my $ctx = shift;	885	my $ctx = shift;
709		886
710	$ctx->[2]{$_+0} = $_	887	$ctx->[2]{$_+0} = $_
711	for map { AnyEvent::Log::ctx $_ } @_;	888	for map { AnyEvent::Log::ctx $_ } @_;
		889	AnyEvent::Log::_reassess;
712	}	890	}
713		891
714	sub detach {	892	sub detach {
715	my $ctx = shift;	893	my $ctx = shift;
716		894
717	delete $ctx->[2]{$_+0}	895	delete $ctx->[2]{$_+0}
718	for map { AnyEvent::Log::ctx $_ } @_;	896	for map { AnyEvent::Log::ctx $_ } @_;
		897	AnyEvent::Log::_reassess;
719	}	898	}
720		899
721	sub slaves {	900	sub slaves {
722	undef $_[0][2];	901	undef $_[0][2];
723	&attach;	902	&attach;
		903	AnyEvent::Log::_reassess;
724	}	904	}
725		905
726	=back	906	=back
727		907
728	=head3 LOG TARGETS	908	=head3 LOG TARGETS
…		…
760	your program.	940	your program.
761		941
762	$ctx->levels ("debug", "trace");	942	$ctx->levels ("debug", "trace");
763	$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
764		944
765	=item $ctx->log_to_file ($path)
766
767	Sets the C<log_cb> to log to a file (by appending), unbuffered.
768
769	=item $ctx->log_to_path ($path)
770
771	Same as C<< ->log_to_file >>, but opens the file for each message. This
772	is much slower, but allows you to change/move/rename/delete the file at
773	basically any time.
774
775	=item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message))	945	=item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
776		946
777	Replaces the formatting callback on the context (C<undef> restores the	947	Replaces the formatting callback on the context (C<undef> restores the
778	default formatter).	948	default formatter).
779		949
780	The callback is passed the (possibly fractional) timestamp, the original	950	The callback is passed the (possibly fractional) timestamp, the original
781	logging context, the (numeric) logging level and the raw message string	951	logging context (object, not title), the (numeric) logging level and
782	and needs to return a formatted log message. In most cases this will be a	952	the raw message string and needs to return a formatted log message. In
783	string, but it could just as well be an array reference that just stores	953	most cases this will be a string, but it could just as well be an array
784	the values.	954	reference that just stores the values.
785		955
786	If, for some reaosn, you want to use C<caller> to find out more baout the	956	If, for some reason, you want to use C<caller> to find out more about the
787	logger then you should walk up the call stack until you are no longer	957	logger then you should walk up the call stack until you are no longer
788	inside the C<AnyEvent::Log> package.	958	inside the C<AnyEvent::Log> package.
789		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	});
		973
790	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
791	brackets.	975	brackets.
792		976
793	$ctx->fmt_cb (sub {	977	$ctx->fmt_cb (sub {
794	my ($time, $ctx, $lvl, $msg) = @_;	978	my ($time, $ctx, $lvl, $msg) = @_;
795		979
796	"<$lvl>$msg\n"	980	"<$lvl>$msg\n"
797	});	981	});
798		982
799	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
800	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.
801		985
802	$ctx->fmt_cb (sub { \@_ });	986	$ctx->fmt_cb (sub { \@_ });
803	$ctx->log_cb (sub {	987	$ctx->log_cb (sub {
804	my ($msg) = @_;	988	my ($msg) = @_;
805		989
…		…
810	"$msg->[3]";	994	"$msg->[3]";
811		995
812	0	996	0
813	});	997	});
814		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
815	=cut	1029	=cut
816		1030
817	sub log_cb {	1031	sub log_cb {
818	my ($ctx, $cb) = @_;	1032	my ($ctx, $cb) = @_;
819		1033
…		…
824	my ($ctx, $cb) = @_;	1038	my ($ctx, $cb) = @_;
825		1039
826	$ctx->[4] = $cb;	1040	$ctx->[4] = $cb;
827	}	1041	}
828		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
829	sub log_to_file {	1136	sub log_to_file {
830	my ($ctx, $path) = @_;	1137	my ($ctx, $path) = @_;
831		1138
832	open my $fh, ">>", $path	1139	_log_to_disk $ctx, $path, 1;
833	or die "$path: $!";	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";
834		1161
835	$ctx->log_cb (sub {	1162	$ctx->log_cb (sub {
836	syswrite $fh, shift;	1163	my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
		1164
		1165	Sys::Syslog::syslog ("$facility\|" . ($lvl - 1), $_)
		1166	for split /\n/, $_[0][1];
		1167
837	0	1168	0
838	});	1169	});
839	}	1170	}
840		1171
841	sub log_to_file {
842	my ($ctx, $path) = @_;
843
844	$ctx->log_cb (sub {
845	open my $fh, ">>", $path
846	or die "$path: $!";
847
848	syswrite $fh, shift;
849	0
850	});
851	}
852
853	=back	1172	=back
854		1173
855	=head3 MESSAGE LOGGING	1174	=head3 MESSAGE LOGGING
856		1175
857	These methods allow you to log messages directly to a context, without	1176	These methods allow you to log messages directly to a context, without
…		…
861		1180
862	=item $ctx->log ($level, $msg[, @params])	1181	=item $ctx->log ($level, $msg[, @params])
863		1182
864	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.
865		1184
		1185	Example: log a message in the context of another package.
		1186
		1187	(AnyEvent::Log::ctx "Other::Package")->log (warn => "heely bo");
		1188
866	=item $logger = $ctx->logger ($level[, \$enabled])	1189	=item $logger = $ctx->logger ($level[, \$enabled])
867		1190
868	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
869	context.	1192	context.
870		1193
871	=cut	1194	=cut
872		1195
873	*log = \&AnyEvent::Log::_log;	1196	*log = \&AnyEvent::Log::_log;
874	*logger = \&AnyEvent::Log::_logger;	1197	*logger = \&AnyEvent::Log::_logger;
875		1198
876	1;
877
878	=back	1199	=back
879		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
880	=head1 EXAMPLES	1434	=head1 EXAMPLES
881		1435
882	This section shows some common configurations.	1436	This section shows some common configurations, both as code, and as
		1437	C<PERL_ANYEVENT_LOG> string.
883		1438
884	=over 4	1439	=over 4
885		1440
886	=item Setting the global logging level.	1441	=item Setting the global logging level.
887		1442
888	Either put PERL_ANYEVENT_VERBOSE=<number> into your environment before	1443	Either put C<PERL_ANYEVENT_VERBOSE=><number> into your environment before
889	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:
890		1446
891	PERL_ANYEVENT_VERBOSE=5 ./myprog	1447	PERL_ANYEVENT_VERBOSE=5 ./myprog
892		1448
		1449	PERL_ANYEVENT_LOG=log=warn
		1450
893	$AnyEvent::Log::FILTER->level ("warn");	1451	$AnyEvent::Log::FILTER->level ("warn");
894		1452
895	=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.
896		1454
897	This is affected by the global logging level.	1455	This is affected by the global logging level.
898		1456
899	$AnyEvent::Log::LOG->log_to_file ($path); (sub {	1457	$AnyEvent::Log::LOG->log_to_file ($path);
		1458
		1459	PERL_ANYEVENT_LOG=log=file=/some/path
900		1460
901	=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.
902		1462
903	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
904	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
905	filtering.	1465	filtering.
906		1466
907	$AnyEvent::Log::FILTER->attach	1467	$AnyEvent::Log::FILTER->attach (
908	new AnyEvent::Log::Ctx log_to_file => $path);	1468	new AnyEvent::Log::Ctx log_to_file => $path);
		1469
		1470	PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
909		1471
910	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
911	attached to the toplevel context, which receives all messages I<before>	1473	attached to the toplevel context, which receives all messages I<before>
912	the global filtering.	1474	the global filtering.
913		1475
914	$AnyEvent::Log::COLLECT->attach (	1476	$AnyEvent::Log::COLLECT->attach (
915	new AnyEvent::Log::Ctx log_to_file => $path);	1477	new AnyEvent::Log::Ctx log_to_file => $path);
916		1478
		1479	PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
		1480
917	In both cases, messages are still written to STDERR.	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
918		1499
919	=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).
920		1501
921	Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>	1502	Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
922	context - this simply circumvents the global filtering for trace messages.	1503	context - this simply circumvents the global filtering for trace messages.
923		1504
924	my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;	1505	my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
925	$debug->attach ($AnyEvent::Log::LOG);	1506	$debug->attach ($AnyEvent::Log::LOG);
		1507
		1508	PERL_ANYEVENT_LOG=AnyEvent::Debug=+log
926		1509
927	This of course works for any package, not just L<AnyEvent::Debug>, but	1510	This of course works for any package, not just L<AnyEvent::Debug>, but
928	assumes the log level for AnyEvent::Debug hasn't been changed from the	1511	assumes the log level for AnyEvent::Debug hasn't been changed from the
929	default.	1512	default.
930		1513
931	=back	1514	=back
932		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
933	=head1 AUTHOR	1522	=head1 AUTHOR
934		1523
935	Marc Lehmann <schmorp@schmorp.de>	1524	Marc Lehmann <schmorp@schmorp.de>
936	http://home.schmorp.de/	1525	http://anyevent.schmorp.de
937		1526
938	=cut	1527	=cut
		1528
		1529	1
		1530

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents): Revision 1.18 by root, Sat Aug 20 15:57:35 2011 UTC vs. Revision 1.73 by root, Sun Apr 24 21:22:38 2022 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents):
Revision 1.18 by root, Sat Aug 20 15:57:35 2011 UTC vs.
Revision 1.73 by root, Sun Apr 24 21:22:38 2022 UTC