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

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents):
Revision 1.8 by root, Fri Aug 19 19:20:36 2011 UTC vs.
Revision 1.16 by root, Sat Aug 20 02:19:18 2011 UTC

…		…
10	AE::log debug => "hit my knee";	10	AE::log debug => "hit my knee";
11	AE::log warn => "it's a bit too hot";	11	AE::log warn => "it's a bit too hot";
12	AE::log error => "the flag was false!";	12	AE::log error => "the flag was false!";
13	AE::log fatal => "the bit toggled! run!";	13	AE::log fatal => "the bit toggled! run!";
14		14
15	# complex use	15	# "complex" use
16	use AnyEvent::Log;	16	use AnyEvent::Log;
17		17
18	my $tracer = AnyEvent::Log::logger trace => \$my $trace;	18	my $tracer = AnyEvent::Log::logger trace => \$my $trace;
19		19
20	$tracer->("i am here") if $trace;	20	$tracer->("i am here") if $trace;
21	$tracer->(sub { "lots of data: " . Dumper $self }) if $trace;	21	$tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
22		22
23	#TODO: config	23	# configuration
24	#TODO: ctx () becomes caller[0]...	24
		25	# set logging for this package to errors and higher only
		26	AnyEvent::Log::ctx->level ("error");
		27
		28	# set logging globally to anything below debug
		29	$AnyEvent::Log::Root->level ("notice");
		30
		31	# see also EXAMPLES, below
25		32
26	=head1 DESCRIPTION	33	=head1 DESCRIPTION
27		34
28	This module implements a relatively simple "logging framework". It doesn't	35	This module implements a relatively simple "logging framework". It doesn't
29	attempt to be "the" logging solution or even "a" logging solution for	36	attempt to be "the" logging solution or even "a" logging solution for
30	AnyEvent - AnyEvent simply creates logging messages internally, and this	37	AnyEvent - AnyEvent simply creates logging messages internally, and this
31	module more or less exposes the mechanism, with some extra spiff to allow	38	module more or less exposes the mechanism, with some extra spiff to allow
32	using it from other modules as well.	39	using it from other modules as well.
33		40
34	Remember that the default verbosity level is C<0>, so nothing will be	41	Remember that the default verbosity level is C<0>, so nothing will be
35	logged, ever, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number	42	logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number before
36	before starting your program.#TODO	43	starting your program, or change the logging level at runtime with
		44	something like:
37		45
38	Possible future extensions are to allow custom log targets (where the	46	use AnyEvent;
39	level is an object), log filtering based on package, formatting, aliasing	47	(AnyEvent::Log::ctx "")->level ("info");
40	or package groups.
41		48
		49	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
		51	extensive enough for the most common tasks, such as logging to multiple
		52	targets, or being able to log into a database.
		53
		54	The amount of documentation might indicate otherwise, but the module is
		55	still just 240 lines or so.
		56
42	=head1 LOG FUNCTIONS	57	=head1 LOGGING FUNCTIONS
43		58
44	These functions allow you to log messages. They always use the caller's	59	These functions allow you to log messages. They always use the caller's
45	package as a "logging module/source". Also, the main logging function is	60	package as a "logging module/source". Also, the main logging function is
46	callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is	61	callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is
47	loaded.	62	loaded.
…		…
56	use POSIX ();	71	use POSIX ();
57		72
58	use AnyEvent (); BEGIN { AnyEvent::common_sense }	73	use AnyEvent (); BEGIN { AnyEvent::common_sense }
59	use AnyEvent::Util ();	74	use AnyEvent::Util ();
60		75
		76	our $VERSION = $AnyEvent::VERSION;
		77
61	our ($now_int, $now_str1, $now_str2);	78	our ($now_int, $now_str1, $now_str2);
62		79
63	# Format Time, not public - yet?	80	# Format Time, not public - yet?
64	sub ft($) {	81	sub ft($) {
65	my $i = int $_[0];	82	my $i = int $_[0];
…		…
71	"$now_str1$f$now_str2"	88	"$now_str1$f$now_str2"
72	}	89	}
73		90
74	our %CTX; # all logging contexts	91	our %CTX; # all logging contexts
75		92
76	my $default_log_cb = sub { 0 };
77
78	# creates a default package context object for the given package	93	# creates a default package context object for the given package
79	sub _pkg_ctx($) {	94	sub _pkg_ctx($) {
80	my $ctx = bless [$_[0], 0, {}, $default_log_cb], "AnyEvent::Log::Ctx";	95	my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx";
81		96
82	# link "parent" package	97	# link "parent" package
83	my $pkg = $_[0] =~ /^(.+)::/ ? $1 : "";	98	my $pkg = $_[0] =~ /^(.+)::/ ? $1 : "AE::Log::Top";
84		99
85	$pkg = $CTX{$pkg} \|\|= &_pkg_ctx ($pkg);	100	$pkg = $CTX{$pkg} \|\|= &_pkg_ctx ($pkg);
86	$ctx->[2]{$pkg+0} = $pkg;	101	$ctx->[2]{$pkg+0} = $pkg;
87		102
88	$ctx	103	$ctx
…		…
114	Note that you can (and should) call this function as C<AnyEvent::log> or	129	Note that you can (and should) call this function as C<AnyEvent::log> or
115	C<AE::log>, without C<use>-ing this module if possible (i.e. you don't	130	C<AE::log>, without C<use>-ing this module if possible (i.e. you don't
116	need any additional functionality), as those functions will load the	131	need any additional functionality), as those functions will load the
117	logging module on demand only. They are also much shorter to write.	132	logging module on demand only. They are also much shorter to write.
118		133
119	Also, if you otpionally generate a lot of debug messages (such as when	134	Also, if you optionally generate a lot of debug messages (such as when
120	tracing some code), you should look into using a logger callback and a	135	tracing some code), you should look into using a logger callback and a
121	boolean enabler (see C<logger>, below).	136	boolean enabler (see C<logger>, below).
122		137
123	Example: log something at error level.	138	Example: log something at error level.
124		139
…		…
146	debug => 8,	161	debug => 8,
147	trace => 9,	162	trace => 9,
148	);	163	);
149		164
150	sub now () { time }	165	sub now () { time }
		166
151	AnyEvent::post_detect {	167	AnyEvent::post_detect {
152	*now = \&AE::now;	168	*now = \&AE::now;
153	};	169	};
154		170
155	our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);	171	our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
156		172
157	# time, ctx, level, msg	173	# time, ctx, level, msg
158	sub _format($$$$) {	174	sub _format($$$$) {
159	my $pfx = ft $_[0];	175	my $ts = ft $_[0];
		176	my $ct = " ";
160		177
161	join "",	178	my @res;
162	map "$pfx $_\n",	179
163	split /\n/,
164	sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]	180	for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) {
		181	push @res, "$ts$ct$_\n";
		182	$ct = " + ";
		183	}
		184
		185	join "", @res
165	}	186	}
166		187
167	sub _log {	188	sub _log {
168	my ($ctx, $level, $format, @args) = @_;	189	my ($ctx, $level, $format, @args) = @_;
169		190
		191	$level = $level > 0 && $level <= 9
		192	? $level+0
170	$level = $level > 0 && $level <= 9 ? $level+0 : $STR2LEVEL{$level} \|\| Carp::croak "$level: not a valid logging level, caught";	193	: $STR2LEVEL{$level} \|\| Carp::croak "$level: not a valid logging level, caught";
171		194
172	my $mask = 1 << $level;	195	my $mask = 1 << $level;
173	my $now = AE::now;
174		196
175	my (@ctx, $did_format, $fmt);	197	my (%seen, @ctx, $now, $fmt);
176		198
177	do {	199	do
178	if ($ctx->[1] & $mask) {	200	{
		201	# skip if masked
		202	if ($ctx->[1] & $mask && !$seen{$ctx+0}++) {
		203	if ($ctx->[3]) {
179	# logging target found	204	# logging target found
180		205
181	# get raw message	206	# now get raw message, unless we have it already
182	unless ($did_format) {	207	unless ($now) {
183	$format = $format->() if ref $format;	208	$format = $format->() if ref $format;
184	$format = sprintf $format, @args if @args;	209	$format = sprintf $format, @args if @args;
185	$format =~ s/\n$//;	210	$format =~ s/\n$//;
186	$did_format = 1;	211	$now = AE::now;
187	};	212	};
188		213
189	# format msg	214	# format msg
190	my $str = $ctx->[4]	215	my $str = $ctx->[4]
191	? $ctx->[4]($now, $_[0], $level, $format)	216	? $ctx->[4]($now, $_[0], $level, $format)
192	: $fmt \|\|= _format $now, $_[0], $level, $format;	217	: $fmt \|\|= _format $now, $_[0], $level, $format;
193		218
194	$ctx->[3]($str)	219	$ctx->[3]($str);
195	and next;	220	}
		221
		222	# not masked, not consumed - propagate to parent contexts
		223	push @ctx, values %{ $ctx->[2] };
		224	}
196	}	225	}
197
198	# not consume - push parent contexts
199	push @ctx, values %{ $ctx->[2] };
200	} while $ctx = pop @ctx;	226	while $ctx = pop @ctx;
201		227
202	exit 1 if $level <= 1;	228	exit 1 if $level <= 1;
203	}	229	}
204		230
205	sub log($$;@) {	231	sub log($$;@) {
…		…
246	# and later in your program	272	# and later in your program
247	$debug_log->("yo, stuff here") if $debug;	273	$debug_log->("yo, stuff here") if $debug;
248		274
249	$debug and $debug_log->("123");	275	$debug and $debug_log->("123");
250		276
251	Note: currently the enabled var is always true - that will be fixed in a
252	future version :)
253
254	=cut	277	=cut
255		278
256	our %LOGGER;	279	our %LOGGER;
257		280
258	# re-assess logging status for all loggers	281	# re-assess logging status for all loggers
259	sub _reassess {	282	sub _reassess {
260	for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {	283	for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
261	my ($ctx, $level, $renabled) = @$_;	284	my ($ctx, $level, $renabled) = @$_;
262		285
263	# to detetc whether a message would be logged, we # actually	286	# to detect whether a message would be logged, we # actually
264	# try to log one and die. this isn't # fast, but we can be	287	# try to log one and die. this isn't fast, but we can be
265	# sure that the logging decision is correct :)	288	# sure that the logging decision is correct :)
266		289
267	$$renabled = !eval {	290	$$renabled = !eval {
268	local $SIG{__DIE__};	291	local $SIG{__DIE__};
269		292
…		…
274		297
275	$$renabled = 1; # TODO	298	$$renabled = 1; # TODO
276	}	299	}
277	}	300	}
278		301
279	sub _logger($;$) {	302	sub _logger {
280	my ($ctx, $level, $renabled) = @_;	303	my ($ctx, $level, $renabled) = @_;
281
282	$renabled \|\|= \my $enabled;
283		304
284	$$renabled = 1;	305	$$renabled = 1;
285		306
286	my $logger = [$ctx, $level, $renabled];	307	my $logger = [$ctx, $level, $renabled];
287		308
…		…
306	_logger	327	_logger
307	$CTX{ (caller)[0] } \|\|= _pkg_ctx +(caller)[0],	328	$CTX{ (caller)[0] } \|\|= _pkg_ctx +(caller)[0],
308	@_	329	@_
309	}	330	}
310		331
311	#TODO
312
313	=back	332	=back
314		333
315	=head1 CONFIGURATION FUNCTIONALITY	334	=head1 LOGGING CONTEXTS
316		335
317	None, yet, except for C<PERL_ANYEVENT_VERBOSE>, described in the L<AnyEvent> manpage.	336	This module associates every log message with a so-called I<logging
		337	context>, based on the package of the caller. Every perl package has its
		338	own logging context.
318		339
319	#TODO: wahst a context	340	A logging context has three major responsibilities: filtering, logging and
320	#TODO	341	propagating the message.
		342
		343	For the first purpose, filtering, each context has a set of logging
		344	levels, called the log level mask. Messages not in the set will be ignored
		345	by this context (masked).
		346
		347	For logging, the context stores a formatting callback (which takes the
		348	timestamp, context, level and string message and formats it in the way
		349	it should be logged) and a logging callback (which is responsible for
		350	actually logging the formatted message and telling C<AnyEvent::Log>
		351	whether it has consumed the message, or whether it should be propagated).
		352
		353	For propagation, a context can have any number of attached I<parent
		354	contexts>. Any message that is neither masked by the logging mask nor
		355	masked by the logging callback returning true will be passed to all parent
		356	contexts.
		357
		358	Each call to a logging function will log the message at most once per
		359	context, so it does not matter (much) if there are cycles or if the
		360	message can arrive at the same context via multiple paths.
		361
		362	=head2 DEFAULTS
		363
		364	By default, all logging contexts have an full set of log levels ("all"), a
		365	disabled logging callback and the default formatting callback.
		366
		367	Package contexts have the package name as logging title by default.
		368
		369	They have exactly one parent - the context of the "parent" package. The
		370	parent package is simply defined to be the package name without the last
		371	component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>,
		372	and C<AnyEvent> becomes ... C<AnyEvent::Log::Top> which is the
		373	exception of the rule - just like the parent of any package name in
		374	Perl is C<main>, the default parent of any top-level package context is
		375	C<AnyEvent::Log::Top>.
		376
		377	Since perl packages form only an approximate hierarchy, this parent
		378	context can of course be removed.
		379
		380	All other (anonymous) contexts have no parents and an empty title by
		381	default.
		382
		383	When the module is loaded it creates the default context called
		384	C<AnyEvent::Log::Default> (also stored in C<$AnyEvent::Log::Default>),
		385	which simply logs everything via C<warn> and doesn't propagate anything
		386	anywhere by default. The purpose of the default context is to provide
		387	a convenient place to override the global logging target or to attach
		388	additional log targets. It's not meant for filtering.
		389
		390	It then creates the root context called C<AnyEvent::Log::Root> (also
		391	stored in C<$AnyEvent::Log::Root>) and sets its log level set to all
		392	levels up to the one specified by C<$ENV{PERL_ANYEVENT_VERBOSE}>. It
		393	then attached the default logging context to it. The purpose of the root
		394	context is to simply provide filtering according to some global log level.
		395
		396	Finally it creates the top-level package context called
		397	C<AnyEvent::Log::Top> (also stored in, you might have guessed,
		398	C<$AnyEvent::Log::Top>) and attached the root context but otherwise leaves
		399	it at default config. It's purpose is simply to collect all log messages
		400	system-wide.
		401
		402	These three special contexts can also be referred to by the
		403	package/context names C<AE::Log::Default>, C<AE::Log::Root> and
		404	C<AE::Log::Top>.
		405
		406	The effect of all this is that log messages, by default, wander up
		407	to the root context where log messages with lower priority then
		408	C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered away and then to the
		409	AnyEvent::Log::Default context to be passed to C<warn>.
		410
		411	Splitting the top level context into three contexts makes it easy to set
		412	a global logging level (by modifying the root context), but still allow
		413	other contexts to log, for example, their debug and trace messages to the
		414	default target despite the global logging level, or to attach additional
		415	log targets that log messages, regardless of the global logging level.
		416
		417	It also makes it easy to replace the default warn-logger by something that
		418	logs to a file, or to attach additional logging targets.
		419
		420	=head2 CREATING/FINDING/DESTROYING CONTEXTS
321		421
322	=over 4	422	=over 4
323		423
324	=item $ctx = AnyEvent::Log::ctx [$pkg]	424	=item $ctx = AnyEvent::Log::ctx [$pkg]
325		425
326	Returns a I<config> object for the given package name.	426	This function creates or returns a logging context (which is an object).
327		427
328	If no package name is given, returns the context for the current perl	428	If a package name is given, then the context for that packlage is
		429	returned. If it is called without any arguments, then the context for the
329	package (i.e. the same context as a C<AE::log> call would use).	430	callers package is returned (i.e. the same context as a C<AE::log> call
		431	would use).
330		432
331	If C<undef> is given, then it creates a new anonymous context that is not	433	If C<undef> is given, then it creates a new anonymous context that is not
332	tied to any package and is destroyed when no longer referenced.	434	tied to any package and is destroyed when no longer referenced.
333		435
334	=cut	436	=cut
…		…
338		440
339	ref $pkg	441	ref $pkg
340	? $pkg	442	? $pkg
341	: defined $pkg	443	: defined $pkg
342	? $CTX{$pkg} \|\|= AnyEvent::Log::_pkg_ctx $pkg	444	? $CTX{$pkg} \|\|= AnyEvent::Log::_pkg_ctx $pkg
343	: bless [undef, 0, undef, $default_log_cb], "AnyEvent::Log::Ctx"	445	: bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx"
344	}	446	}
345		447
346	# create default root context	448	=item AnyEvent::Log::reset
347	{	449
348	my $root = ctx undef;	450	Resets all package contexts and recreates the default hierarchy if
349	$root->[0] = "";	451	necessary, i.e. resets the logging subsystem to defaults, as much as
350	$root->title ("default");	452	possible. This process keeps references to contexts held by other parts of
351	$root->level ($AnyEvent::VERBOSE);	453	the program intact.
352	$root->log_cb (sub {	454
353	print STDERR shift;	455	This can be used to implement config-file (re-)loading: before loading a
		456	configuration, reset all contexts.
		457
		458	=cut
		459
		460	sub reset {
		461	# hard to kill complex data structures
		462	# we recreate all package loggers and reset the hierarchy
		463	while (my ($k, $v) = each %CTX) {
		464	@$v = ($k, (1 << 10) - 1 - 1, { });
		465
		466	my $pkg = $k =~ /^(.+)::/ ? $1 : "AE::Log::Top";
		467	$v->attach ($CTX{$pkg});
		468	}
		469
		470	$AnyEvent::Log::Default->parents;
		471	$AnyEvent::Log::Default->title ("AnyEvent::Log::Default");
		472	$AnyEvent::Log::Default->log_cb (sub {
		473	warn shift;
354	0	474	0
355	});	475	});
356	$CTX{""} = $root;	476	$CTX{"AnyEvent::Log::Default"} = $CTX{"AE::Log::Default"} = $AnyEvent::Log::Default;
		477
		478	$AnyEvent::Log::Root->parents ($AnyEvent::Log::Default);
		479	$AnyEvent::Log::Root->title ("AnyEvent::Log::Root");
		480	$AnyEvent::Log::Root->level ($AnyEvent::VERBOSE);
		481	$CTX{"AnyEvent::Log::Root"} = $CTX{"AE::Log::Root"} = $AnyEvent::Log::Root;
		482
		483	$AnyEvent::Log::Top->parents ($AnyEvent::Log::Root);
		484	$AnyEvent::Log::Top->title ("AnyEvent::Log::Top");
		485	$CTX{"AnyEvent::Log::Top"} = $CTX{"AE::Log::Top"} = $AnyEvent::Log::Top;
		486
		487	_reassess;
357	}	488	}
		489
		490	# create the default logger contexts
		491	$AnyEvent::Log::Default = ctx undef;
		492	$AnyEvent::Log::Root = ctx undef;
		493	$AnyEvent::Log::Top = ctx undef;
		494
		495	AnyEvent::Log::reset;
		496
		497	# hello, CPAN, please catch me
		498	package AnyEvent::Log::Default;
		499	package AE::Log::Default;
		500	package AnyEvent::Log::Root;
		501	package AE::Log::Root;
		502	package AnyEvent::Log::Top;
		503	package AE::Log::Top;
358		504
359	package AnyEvent::Log::Ctx;	505	package AnyEvent::Log::Ctx;
360		506
361	# 0 1 2 3 4	507	# 0 1 2 3 4
362	# [$title, $level, %$parents, &$logcb, &$fmtcb]	508	# [$title, $level, %$parents, &$logcb, &$fmtcb]
		509
		510	=item $ctx = new AnyEvent::Log::Ctx methodname => param...
		511
		512	This is a convenience constructor that makes it simpler to construct
		513	anonymous logging contexts.
		514
		515	Each key-value pair results in an invocation of the method of the same
		516	name as the key with the value as parameter, unless the value is an
		517	arrayref, in which case it calls the method with the contents of the
		518	array. The methods are called in the same order as specified.
		519
		520	Example: create a new logging context and set both the default logging
		521	level, some parent contexts and a logging callback.
		522
		523	$ctx = new AnyEvent::Log::Ctx
		524	title => "dubious messages",
		525	level => "error",
		526	log_cb => sub { print STDOUT shift; 0 },
		527	parents => [$ctx1, $ctx, $ctx2],
		528	;
		529
		530	=back
		531
		532	=cut
		533
		534	sub new {
		535	my $class = shift;
		536
		537	my $ctx = AnyEvent::Log::ctx undef;
		538
		539	while (@_) {
		540	my ($k, $v) = splice @_, 0, 2;
		541	$ctx->$k (ref $v eq "ARRAY" ? @$v : $v);
		542	}
		543
		544	bless $ctx, $class # do we really support subclassing, hmm?
		545	}
		546
		547
		548	=head2 CONFIGURING A LOG CONTEXT
		549
		550	The following methods can be used to configure the logging context.
		551
		552	=over 4
363		553
364	=item $ctx->title ([$new_title])	554	=item $ctx->title ([$new_title])
365		555
366	Returns the title of the logging context - this is the package name, for	556	Returns the title of the logging context - this is the package name, for
367	package contexts, and a user defined string for all others.	557	package contexts, and a user defined string for all others.
…		…
373	sub title {	563	sub title {
374	$_[0][0] = $_[1] if @_ > 1;	564	$_[0][0] = $_[1] if @_ > 1;
375	$_[0][0]	565	$_[0][0]
376	}	566	}
377		567
		568	=back
		569
		570	=head3 LOGGING LEVELS
		571
		572	The following methods deal with the logging level set associated with the
		573	log context.
		574
		575	The most common method to use is probably C<< $ctx->level ($level) >>,
		576	which configures the specified and any higher priority levels.
		577
		578	All functions which accept a list of levels also accept the special string
		579	C<all> which expands to all logging levels.
		580
		581	=over 4
		582
378	=item $ctx->levels ($level[, $level...)	583	=item $ctx->levels ($level[, $level...)
379		584
380	Enables logging fot the given levels and disables it for all others.	585	Enables logging for the given levels and disables it for all others.
381		586
382	=item $ctx->level ($level)	587	=item $ctx->level ($level)
383		588
384	Enables logging for the given level and all lower level (higher priority)	589	Enables logging for the given level and all lower level (higher priority)
385	ones. Specifying a level of C<0> or C<off> disables all logging for this	590	ones. In addition to normal logging levels, specifying a level of C<0> or
386	level.	591	C<off> disables all logging for this level.
387		592
388	Example: log warnings, errors and higher priority messages.	593	Example: log warnings, errors and higher priority messages.
389		594
390	$ctx->level ("warn");	595	$ctx->level ("warn");
391	$ctx->level (5); # same thing, just numeric	596	$ctx->level (5); # same thing, just numeric
…		…
399	Disables logging for the given levels, leaving all others unchanged.	604	Disables logging for the given levels, leaving all others unchanged.
400		605
401	=cut	606	=cut
402		607
403	sub _lvl_lst {	608	sub _lvl_lst {
		609	map {
		610	$_ > 0 && $_ <= 9 ? $_+0
		611	: $_ eq "all" ? (1 .. 9)
404	map { $_ > 0 && $_ <= 9 ? $_+0 : $STR2LEVEL{$_} \|\| Carp::croak "$_: not a valid logging level, caught" }	612	: $STR2LEVEL{$_} \|\| Carp::croak "$_: not a valid logging level, caught"
405	@_	613	} @_
406	}	614	}
407		615
408	our $NOP_CB = sub { 0 };	616	our $NOP_CB = sub { 0 };
409		617
410	sub levels {	618	sub levels {
…		…
415	AnyEvent::Log::_reassess;	623	AnyEvent::Log::_reassess;
416	}	624	}
417		625
418	sub level {	626	sub level {
419	my $ctx = shift;	627	my $ctx = shift;
420	my $lvl = $_[0] =~ /^(?:0\|off\|none)$/ ? 0 : (_lvl_lst $_[0])[0];	628	my $lvl = $_[0] =~ /^(?:0\|off\|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
		629
421	$ctx->[1] = ((1 << $lvl) - 1) << 1;	630	$ctx->[1] = ((1 << $lvl) - 1) << 1;
422	AnyEvent::Log::_reassess;	631	AnyEvent::Log::_reassess;
423	}	632	}
424		633
425	sub enable {	634	sub enable {
…		…
434	$ctx->[1] &= ~(1 << $_)	643	$ctx->[1] &= ~(1 << $_)
435	for &_lvl_lst;	644	for &_lvl_lst;
436	AnyEvent::Log::_reassess;	645	AnyEvent::Log::_reassess;
437	}	646	}
438		647
		648	=back
		649
		650	=head3 PARENT CONTEXTS
		651
		652	The following methods attach and detach another logging context to a
		653	logging context.
		654
		655	Log messages are propagated to all parent contexts, unless the logging
		656	callback consumes the message.
		657
		658	=over 4
		659
439	=item $ctx->attach ($ctx2[, $ctx3...])	660	=item $ctx->attach ($ctx2[, $ctx3...])
440		661
441	Attaches the given contexts as parents to this context. It is not an error	662	Attaches the given contexts as parents to this context. It is not an error
442	to add a context twice (the second add will be ignored).	663	to add a context twice (the second add will be ignored).
443		664
…		…
448	Removes the given parents from this context - it's not an error to attempt	669	Removes the given parents from this context - it's not an error to attempt
449	to remove a context that hasn't been added.	670	to remove a context that hasn't been added.
450		671
451	A context can be specified either as package name or as a context object.	672	A context can be specified either as package name or as a context object.
452		673
		674	=item $ctx->parents ($ctx2[, $ctx3...])
		675
		676	Replaces all parents attached to this context by the ones given.
		677
453	=cut	678	=cut
454		679
455	sub attach {	680	sub attach {
456	my $ctx = shift;	681	my $ctx = shift;
457		682
…		…
463	my $ctx = shift;	688	my $ctx = shift;
464		689
465	delete $ctx->[2]{$_+0}	690	delete $ctx->[2]{$_+0}
466	for map { AnyEvent::Log::ctx $_ } @_;	691	for map { AnyEvent::Log::ctx $_ } @_;
467	}	692	}
		693
		694	sub parents {
		695	undef $_[0][2];
		696	&attach;
		697	}
		698
		699	=back
		700
		701	=head3 MESSAGE LOGGING
		702
		703	The following methods configure how the logging context actually does
		704	the logging (which consists of formatting the message and printing it or
		705	whatever it wants to do with it) and also allows you to log messages
		706	directly to a context, without going via your package context.
		707
		708	=over 4
468		709
469	=item $ctx->log_cb ($cb->($str))	710	=item $ctx->log_cb ($cb->($str))
470		711
471	Replaces the logging callback on the context (C<undef> disables the	712	Replaces the logging callback on the context (C<undef> disables the
472	logging callback).	713	logging callback).
…		…
482	Example: a very simple logging callback, simply dump the message to STDOUT	723	Example: a very simple logging callback, simply dump the message to STDOUT
483	and do not consume it.	724	and do not consume it.
484		725
485	$ctx->log_cb (sub { print STDERR shift; 0 });	726	$ctx->log_cb (sub { print STDERR shift; 0 });
486		727
		728	You can filter messages by having a log callback that simply returns C<1>
		729	and does not do anything with the message, but this counts as "message
		730	being logged" and might not be very efficient.
		731
		732	Example: propagate all messages except for log levels "debug" and
		733	"trace". The messages will still be generated, though, which can slow down
		734	your program.
		735
		736	$ctx->levels ("debug", "trace");
		737	$ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
		738
487	=item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message))	739	=item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message))
488		740
489	Replaces the fornatting callback on the cobntext (C<undef> restores the	741	Replaces the formatting callback on the context (C<undef> restores the
490	default formatter).	742	default formatter).
491		743
492	The callback is passed the (possibly fractional) timestamp, the original	744	The callback is passed the (possibly fractional) timestamp, the original
493	logging context, the (numeric) logging level and the raw message string and needs to	745	logging context, the (numeric) logging level and the raw message string and needs to
494	return a formatted log message. In most cases this will be a string, but	746	return a formatted log message. In most cases this will be a string, but
…		…
522	=cut	774	=cut
523		775
524	sub log_cb {	776	sub log_cb {
525	my ($ctx, $cb) = @_;	777	my ($ctx, $cb) = @_;
526		778
527	$ctx->[3] = $cb \|\| $default_log_cb;	779	$ctx->[3] = $cb;
528	}	780	}
529		781
530	sub fmt_cb {	782	sub fmt_cb {
531	my ($ctx, $cb) = @_;	783	my ($ctx, $cb) = @_;
532		784
…		…
549		801
550	1;	802	1;
551		803
552	=back	804	=back
553		805
		806	=head1 EXAMPLES
		807
		808	This section shows some common configurations.
		809
		810	=over 4
		811
		812	=item Setting the global logging level.
		813
		814	Either put PERL_ANYEVENT_VERBOSE=<number> into your environment before
		815	running your program, or modify the log level of the root context:
		816
		817	PERL_ANYEVENT_VERBOSE=5 ./myprog
		818
		819	$AnyEvent::Log::Root->level ("warn");
		820
		821	=item Append all messages to a file instead of sending them to STDERR.
		822
		823	This is affected by the global logging level.
		824
		825	open my $fh, ">>", $path
		826	or die "$path: $!";
		827
		828	$AnyEvent::Log::Default->log_cb (sub {
		829	syswrite $fh, shift;
		830	0
		831	});
		832
		833	=item Write all messages with priority C<error> and higher to a file.
		834
		835	This writes them only when the global logging level allows it, because
		836	it is attached to the default context which is invoked I<after> global
		837	filtering.
		838
		839	open my $fh, ">>", $path
		840	or die "$path: $!";
		841
		842	$AnyEvent::Log::Default->attach (new AnyEvent::Log::Ctx
		843	log_cb => sub { syswrite $fh, shift; 0 });
		844
		845	This writes them regardless of the global logging level, because it is
		846	attached to the toplevel context, which receives all messages I<before>
		847	the global filtering.
		848
		849	$AnyEvent::Log::Top->attach (new AnyEvent::Log::Ctx
		850	log_cb => sub { syswrite $fh, shift; 0 });
		851
		852	In both cases, messages are still written to STDOUT.
		853
		854	=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
		855
		856	Attach the CyAnyEvent::Log::Default> context to the C<AnyEvent::Debug>
		857	context and increase the C<AnyEvent::Debug> logging level - this simply
		858	circumvents the global filtering for trace messages.
		859
		860	my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
		861	$debug->attach ($AnyEvent::Log::Default);
		862	$debug->levels ("trace"); # not "level"!
		863
		864	This of course works for any package.
		865
		866	=back
		867
554	=head1 AUTHOR	868	=head1 AUTHOR
555		869
556	Marc Lehmann <schmorp@schmorp.de>	870	Marc Lehmann <schmorp@schmorp.de>
557	http://home.schmorp.de/	871	http://home.schmorp.de/
558		872

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents): Revision 1.8 by root, Fri Aug 19 19:20:36 2011 UTC vs. Revision 1.16 by root, Sat Aug 20 02:19:18 2011 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents):
Revision 1.8 by root, Fri Aug 19 19:20:36 2011 UTC vs.
Revision 1.16 by root, Sat Aug 20 02:19:18 2011 UTC