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.1 by root, Mon Aug 15 23:21:09 2011 UTC vs.
Revision 1.71 by root, Mon Aug 3 20:53:18 2020 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 uses:
		8
		9	use AnyEvent;
		10
		11	AE::log fatal => "No config found, cannot continue!"; # never returns
		12	AE::log alert => "The battery died!";
		13	AE::log crit => "The battery is too hot!";
		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";
		20
		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
7	use AnyEvent::Log;	36	use AnyEvent::Log;
8		37
		38	my $tracer = AnyEvent::Log::logger trace => \my $trace;
		39
		40	$tracer->("i am here") if $trace;
		41	$tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
		42
		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");
		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	);
		66
9	=head1 DESCRIPTION	67	=head1 DESCRIPTION
10		68
		69	This module implements a relatively simple "logging framework". It doesn't
		70	attempt to be "the" logging solution or even "a" logging solution for
		71	AnyEvent - AnyEvent simply creates logging messages internally, and this
		72	module more or less exposes the mechanism, with some extra spiff to allow
		73	using it from other modules as well.
		74
		75	Remember that the default verbosity level is C<4> (C<error>), so only
		76	errors and more important messages will be logged, unless you set
		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:
		80
		81	use AnyEvent::Log;
		82	$AnyEvent::Log::FILTER->level ("info");
		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
11	=head1 FUNCTIONS	137	=head1 LOGGING FUNCTIONS
		138
		139	The following functions allow you to log messages. They always use the
		140	caller's package as a "logging context". Also, the main logging function,
		141	C<log>, is aliased to C<AnyEvent::log> and C<AE::log> when the C<AnyEvent>
		142	module is loaded.
12		143
13	=over 4	144	=over 4
14		145
15	=cut	146	=cut
16		147
17	package AnyEvent::Log;	148	package AnyEvent::Log;
18		149
		150	use Carp ();
19	use POSIX ();	151	use POSIX ();
20		152
		153	# layout of a context
		154	# 0 1 2 3 4, 5
		155	# [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap]
		156
21	use AnyEvent (); BEGIN { AnyEvent::common_sense }	157	use AnyEvent (); BEGIN { AnyEvent::common_sense }
		158	#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log
22		159
23	1;	160	our $VERSION = $AnyEvent::VERSION;
		161
		162	our ($COLLECT, $FILTER, $LOG);
		163
		164	our ($now_int, $now_str1, $now_str2);
		165
		166	# Format Time, not public - yet?
		167	sub format_time($) {
		168	my $i = int $_[0];
		169	my $f = sprintf "%06d", 1e6 * ($_[0] - $i);
		170
		171	($now_int, $now_str1, $now_str2) = ($i, split /\x01/, POSIX::strftime "%Y-%m-%d %H:%M:%S.\x01 %z", localtime $i)
		172	if $now_int != $i;
		173
		174	"$now_str1$f$now_str2"
		175	}
		176
		177	our %CTX; # all package contexts
		178
		179	# creates a default package context object for the given package
		180	sub _pkg_ctx($) {
		181	my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx";
		182
		183	# link "parent" package
		184	my $parent = $_[0] =~ /^(.+)::/
		185	? $CTX{$1} ||= &_pkg_ctx ("$1")
		186	: $COLLECT;
		187
		188	$ctx->[2]{$parent+0} = $parent;
		189
		190	$ctx
		191	}
		192
		193	=item AnyEvent::Log::log $level, $msg[, @args]
		194
		195	Requests logging of the given C<$msg> with the given log level, and
		196	returns true if the message was logged I<somewhere>.
		197
		198	For loglevel C<fatal>, the program will abort.
		199
		200	If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the
		201	C<$msg> is interpreted as an sprintf format string.
		202
		203	The C<$msg> should not end with C<\n>, but may if that is convenient for
		204	you. Also, multiline messages are handled properly.
		205
		206	Last not least, C<$msg> might be a code reference, in which case it is
		207	supposed to return the message. It will be called only then the message
		208	actually gets logged, which is useful if it is costly to create the
		209	message in the first place.
		210
		211	This function takes care of saving and restoring C<$!> and C<$@>, so you
		212	don't have to.
		213
		214	Whether the given message will be logged depends on the maximum log level
		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.
		219
		220	Note that you can (and should) call this function as C<AnyEvent::log> or
		221	C<AE::log>, without C<use>-ing this module if possible (i.e. you don't
		222	need any additional functionality), as those functions will load the
		223	logging module on demand only. They are also much shorter to write.
		224
		225	Also, if you optionally generate a lot of debug messages (such as when
		226	tracing some code), you should look into using a logger callback and a
		227	boolean enabler (see C<logger>, below).
		228
		229	Example: log something at error level.
		230
		231	AE::log error => "something";
		232
		233	Example: use printf-formatting.
		234
		235	AE::log info => "%5d %-10.10s %s", $index, $category, $msg;
		236
		237	Example: only generate a costly dump when the message is actually being logged.
		238
		239	AE::log debug => sub { require Data::Dump; Data::Dump::dump \%cache };
		240
		241	=cut
		242
		243	# also allow syslog equivalent names
		244	our %STR2LEVEL = (
		245	fatal => 1, emerg => 1, exit => 1,
		246	alert => 2,
		247	critical => 3, crit => 3,
		248	error => 4, err => 4, die => 4,
		249	warn => 5, warning => 5,
		250	note => 6, notice => 6,
		251	info => 7,
		252	debug => 8,
		253	trace => 9,
		254	);
		255
		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
		269	AnyEvent::post_detect {
		270	exact_time $TIME_EXACT;
		271	};
		272
		273	our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
		274
		275	# time, ctx, level, msg
		276	sub default_format($$$$) {
		277	my $ts = format_time $_[0];
		278	my $ct = " ";
		279
		280	my @res;
		281
		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;
		292	}
		293
		294	sub _log {
		295	my ($ctx, $level, $format, @args) = @_;
		296
		297	$level = $level > 0 && $level <= 9
		298	? $level+0
		299	: $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
		300
		301	my $mask = 1 << $level;
		302
		303	my ($success, %seen, @ctx, $now, @fmt);
		304
		305	do
		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]) {
		321	# logging target found
		322
		323	local ($!, $@);
		324
		325	# now get raw message, unless we have it already
		326	unless ($now) {
		327	$format = $format->() if ref $format;
		328	$format = sprintf $format, @args if @args;
		329	$format =~ s/\n$//;
		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	}
		345	}
		346	}
		347	while $ctx = pop @ctx;
		348
		349	fatal_exit if $level <= 1;
		350
		351	$success
		352	}
		353
		354	sub log($$;@) {
		355	_log
		356	$CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
		357	@_;
		358	}
		359
		360	=item $logger = AnyEvent::Log::logger $level[, \$enabled]
		361
		362	Creates a code reference that, when called, acts as if the
		363	C<AnyEvent::Log::log> function was called at this point with the given
		364	level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
		365	the C<AnyEvent::Log::log> function:
		366
		367	my $debug_log = AnyEvent::Log::logger "debug";
		368
		369	$debug_log->("debug here");
		370	$debug_log->("%06d emails processed", 12345);
		371	$debug_log->(sub { $obj->as_string });
		372
		373	The idea behind this function is to decide whether to log before actually
		374	logging - when the C<logger> function is called once, but the returned
		375	logger callback often, then this can be a tremendous speed win.
		376
		377	Despite this speed advantage, changes in logging configuration will
		378	still be reflected by the logger callback, even if configuration changes
		379	I<after> it was created.
		380
		381	To further speed up logging, you can bind a scalar variable to the logger,
		382	which contains true if the logger should be called or not - if it is
		383	false, calling the logger can be safely skipped. This variable will be
		384	updated as long as C<$logger> is alive.
		385
		386	Full example:
		387
		388	# near the init section
		389	use AnyEvent::Log;
		390
		391	my $debug_log = AnyEvent:Log::logger debug => \my $debug;
		392
		393	# and later in your program
		394	$debug_log->("yo, stuff here") if $debug;
		395
		396	$debug and $debug_log->("123");
		397
		398	=cut
		399
		400	our %LOGGER;
		401
		402	# re-assess logging status for all loggers
		403	sub _reassess {
		404	local $SIG{__DIE__};
		405	my $die = sub { die };
		406
		407	for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
		408	my ($ctx, $level, $renabled) = @$_;
		409
		410	# to detect whether a message would be logged, we actually
		411	# try to log one and die. this isn't fast, but we can be
		412	# sure that the logging decision is correct :)
		413
		414	$$renabled = !eval {
		415	_log $ctx, $level, $die;
		416
		417	1
		418	};
		419	}
		420	}
		421
		422	sub _logger {
		423	my ($ctx, $level, $renabled) = @_;
		424
		425	$$renabled = 1;
		426
		427	my $logger = [$ctx, $level, $renabled];
		428
		429	$LOGGER{$logger+0} = $logger;
		430
		431	_reassess $logger+0;
		432
		433	require AnyEvent::Util unless $AnyEvent::Util::VERSION;
		434	my $guard = AnyEvent::Util::guard (sub {
		435	# "clean up"
		436	delete $LOGGER{$logger+0};
		437	});
		438
		439	sub {
		440	$guard if 0; # keep guard alive, but don't cause runtime overhead
		441
		442	_log $ctx, $level, @_
		443	if $$renabled;
		444	}
		445	}
		446
		447	sub logger($;$) {
		448	_logger
		449	$CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
		450	@_
		451	}
		452
		453	=item AnyEvent::Log::exact_time $on
		454
		455	By default, C<AnyEvent::Log> will use C<AE::now>, i.e. the cached
		456	eventloop time, for the log timestamps. After calling this function with a
		457	true value it will instead resort to C<AE::time>, i.e. fetch the current
		458	time on each log message. This only makes a difference for event loops
		459	that actually cache the time (such as L<EV> or L<AnyEvent::Loop>).
		460
		461	This setting can be changed at any time by calling this function.
		462
		463	Since C<AnyEvent::Log> has to work even before the L<AnyEvent> has been
		464	initialised, this switch will also decide whether to use C<CORE::time> or
		465	C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes
		466	available.
		467
		468	=item AnyEvent::Log::format_time $timestamp
		469
		470	Formats a timestamp as returned by C<< AnyEvent->now >> or C<<
		471	AnyEvent->time >> or many other functions in the same way as
		472	C<AnyEvent::Log> does.
		473
		474	In your main program (as opposed to in your module) you can override
		475	the default timestamp display format by loading this module and then
		476	redefining this function.
		477
		478	Most commonly, this function can be used in formatting callbacks.
		479
		480	=item AnyEvent::Log::default_format $time, $ctx, $level, $msg
		481
		482	Format a log message using the given timestamp, logging context, log level
		483	and log message.
		484
		485	This is the formatting function used to format messages when no custom
		486	function is provided.
		487
		488	In your main program (as opposed to in your module) you can override the
		489	default message format by loading this module and then redefining this
		490	function.
		491
		492	=item AnyEvent::Log::fatal_exit()
		493
		494	This is the function that is called after logging a C<fatal> log
		495	message. It must not return.
		496
		497	The default implementation simply calls C<exit 1>.
		498
		499	In your main program (as opposed to in your module) you can override
		500	the fatal exit function by loading this module and then redefining this
		501	function. Make sure you don't return.
24		502
25	=back	503	=back
26		504
		505	=head1 LOGGING CONTEXTS
		506
		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.
		510
		511	A logging context has three major responsibilities: filtering, logging and
		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
		592
		593	=over 4
		594
		595	=item $ctx = AnyEvent::Log::ctx [$pkg]
		596
		597	This function creates or returns a logging context (which is an object).
		598
		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
		601	callers package is returned (i.e. the same context as a C<AE::log> call
		602	would use).
		603
		604	If C<undef> is given, then it creates a new anonymous context that is not
		605	tied to any package and is destroyed when no longer referenced.
		606
		607	=cut
		608
		609	sub ctx(;$) {
		610	my $pkg = @_ ? shift : (caller)[0];
		611
		612	ref $pkg
		613	? $pkg
		614	: defined $pkg
		615	? $CTX{$pkg} ||= AnyEvent::Log::_pkg_ctx $pkg
		616	: bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx"
		617	}
		618
		619	=item AnyEvent::Log::reset
		620
		621	Resets all package contexts and recreates the default hierarchy if
		622	necessary, i.e. resets the logging subsystem to defaults, as much as
		623	possible. This process keeps references to contexts held by other parts of
		624	the program intact.
		625
		626	This can be used to implement config-file (re-)loading: before loading a
		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);
		641	}
		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;
		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;
		682
		683	package AnyEvent::Log::Ctx;
		684
		685	=item $ctx = new AnyEvent::Log::Ctx methodname => param...
		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
		728
		729	=item $ctx->title ([$new_title])
		730
		731	Returns the title of the logging context - this is the package name, for
		732	package contexts, and a user defined string for all others.
		733
		734	If C<$new_title> is given, then it replaces the package name or title.
		735
		736	=cut
		737
		738	sub title {
		739	$_[0][0] = $_[1] if @_ > 1;
		740	$_[0][0]
		741	}
		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
		758	=item $ctx->levels ($level[, $level...)
		759
		760	Enables logging for the given levels and disables it for all others.
		761
		762	=item $ctx->level ($level)
		763
		764	Enables logging for the given level and all lower level (higher priority)
		765	ones. In addition to normal logging levels, specifying a level of C<0> or
		766	C<off> disables all logging for this level.
		767
		768	Example: log warnings, errors and higher priority messages.
		769
		770	$ctx->level ("warn");
		771	$ctx->level (5); # same thing, just numeric
		772
		773	=item $ctx->enable ($level[, $level...])
		774
		775	Enables logging for the given levels, leaving all others unchanged.
		776
		777	=item $ctx->disable ($level[, $level...])
		778
		779	Disables logging for the given levels, leaving all others unchanged.
		780
		781	=item $ctx->cap ($level)
		782
		783	Caps the maximum priority to the given level, for all messages logged
		784	to, or passing through, this context. That is, while this doesn't affect
		785	whether a message is logged or passed on, the maximum priority of messages
		786	will be limited to the specified level - messages with a higher priority
		787	will be set to the specified priority.
		788
		789	Another way to view this is that C<< ->level >> filters out messages with
		790	a too low priority, while C<< ->cap >> modifies messages with a too high
		791	priority.
		792
		793	This is useful when different log targets have different interpretations
		794	of priority. For example, for a specific command line program, a wrong
		795	command line switch might well result in a C<fatal> log message, while the
		796	same message, logged to syslog, is likely I<not> fatal to the system or
		797	syslog facility as a whole, but more likely a mere C<error>.
		798
		799	This can be modeled by having a stderr logger that logs messages "as-is"
		800	and a syslog logger that logs messages with a level cap of, say, C<error>,
		801	or, for truly system-critical components, actually C<critical>.
		802
		803	=cut
		804
		805	sub _lvl_lst {
		806	map {
		807	$_ > 0 && $_ <= 9 ? $_+0
		808	: $_ eq "all" ? (1 .. 9)
		809	: $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
		810	} @_
		811	}
		812
		813	sub _lvl {
		814	$_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]
		815	}
		816
		817	our $NOP_CB = sub { 0 };
		818
		819	sub levels {
		820	my $ctx = shift;
		821	$ctx->[1] = 0;
		822	$ctx->[1] |= 1 << $_
		823	for &_lvl_lst;
		824	AnyEvent::Log::_reassess;
		825	}
		826
		827	sub level {
		828	my $ctx = shift;
		829	$ctx->[1] = ((1 << &_lvl) - 1) << 1;
		830	AnyEvent::Log::_reassess;
		831	}
		832
		833	sub enable {
		834	my $ctx = shift;
		835	$ctx->[1] |= 1 << $_
		836	for &_lvl_lst;
		837	AnyEvent::Log::_reassess;
		838	}
		839
		840	sub disable {
		841	my $ctx = shift;
		842	$ctx->[1] &= ~(1 << $_)
		843	for &_lvl_lst;
		844	AnyEvent::Log::_reassess;
		845	}
		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
		864	=item $ctx->attach ($ctx2[, $ctx3...])
		865
		866	Attaches the given contexts as slaves to this context. It is not an error
		867	to add a context twice (the second add will be ignored).
		868
		869	A context can be specified either as package name or as a context object.
		870
		871	=item $ctx->detach ($ctx2[, $ctx3...])
		872
		873	Removes the given slaves from this context - it's not an error to attempt
		874	to remove a context that hasn't been added.
		875
		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.
		881
		882	=cut
		883
		884	sub attach {
		885	my $ctx = shift;
		886
		887	$ctx->[2]{$_+0} = $_
		888	for map { AnyEvent::Log::ctx $_ } @_;
		889	AnyEvent::Log::_reassess;
		890	}
		891
		892	sub detach {
		893	my $ctx = shift;
		894
		895	delete $ctx->[2]{$_+0}
		896	for map { AnyEvent::Log::ctx $_ } @_;
		897	AnyEvent::Log::_reassess;
		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
		915
		916	=item $ctx->log_cb ($cb->($str))
		917
		918	Replaces the logging callback on the context (C<undef> disables the
		919	logging callback).
		920
		921	The logging callback is responsible for handling formatted log messages
		922	(see C<fmt_cb> below) - normally simple text strings that end with a
		923	newline (and are possibly multiline themselves).
		924
		925	It also has to return true iff it has consumed the log message, and false
		926	if it hasn't. Consuming a message means that it will not be sent to any
		927	slave context. When in doubt, return C<0> from your logging callback.
		928
		929	Example: a very simple logging callback, simply dump the message to STDOUT
		930	and do not consume it.
		931
		932	$ctx->log_cb (sub { print STDERR shift; 0 });
		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
		945	=item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
		946
		947	Replaces the formatting callback on the context (C<undef> restores the
		948	default formatter).
		949
		950	The callback is passed the (possibly fractional) timestamp, the original
		951	logging context (object, not title), the (numeric) logging level and
		952	the raw message string and needs to return a formatted log message. In
		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	});
		973
		974	Example: format just the raw message, with numeric log level in angle
		975	brackets.
		976
		977	$ctx->fmt_cb (sub {
		978	my ($time, $ctx, $lvl, $msg) = @_;
		979
		980	"<$lvl>$msg\n"
		981	});
		982
		983	Example: return an array reference with just the log values, and use
		984	C<PApp::SQL::sql_exec> to store the message in a database.
		985
		986	$ctx->fmt_cb (sub { \@_ });
		987	$ctx->log_cb (sub {
		988	my ($msg) = @_;
		989
		990	sql_exec "insert into log (when, subsys, prio, msg) values (?, ?, ?, ?)",
		991	$msg->[0] + 0,
		992	"$msg->[1]",
		993	$msg->[2] + 0,
		994	"$msg->[3]";
		995
		996	0
		997	});
		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
		1029	=cut
		1030
		1031	sub log_cb {
		1032	my ($ctx, $cb) = @_;
		1033
		1034	$ctx->[3] = $cb;
		1035	}
		1036
		1037	sub fmt_cb {
		1038	my ($ctx, $cb) = @_;
		1039
		1040	$ctx->[4] = $cb;
		1041	}
		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
		1181	=item $ctx->log ($level, $msg[, @params])
		1182
		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");
		1188
		1189	=item $logger = $ctx->logger ($level[, \$enabled])
		1190
		1191	Same as C<AnyEvent::Log::logger>, but uses the given context as log
		1192	context.
		1193
		1194	=cut
		1195
		1196	*log = \&AnyEvent::Log::_log;
		1197	*logger = \&AnyEvent::Log::_logger;
		1198
		1199	=back
		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
27	=head1 AUTHOR	1522	=head1 AUTHOR
28		1523
29	Marc Lehmann <schmorp@schmorp.de>	1524	Marc Lehmann <schmorp@schmorp.de>
30	http://home.schmorp.de/	1525	http://anyevent.schmorp.de
31		1526
32	=cut	1527	=cut
		1528
		1529	1
		1530

Diff Legend

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