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

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.15 by root, Sat Aug 20 02:16:59 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.15 by root, Sat Aug 20 02:16:59 2011 UTC