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

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents):
Revision 1.10 by root, Fri Aug 19 21:17:08 2011 UTC vs.
Revision 1.12 by root, Sat Aug 20 01:33:10 2011 UTC

…		…
45	AnyEvent - AnyEvent simply creates logging messages internally, and this	45	AnyEvent - AnyEvent simply creates logging messages internally, and this
46	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
47	using it from other modules as well.	47	using it from other modules as well.
48		48
49	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
50	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
51	before starting your program, or change the logging level at runtime wiht	51	starting your program, or change the logging level at runtime with
52	something like:	52	something like:
53		53
54	use AnyEvent;	54	use AnyEvent;
55	(AnyEvent::Log::ctx "")->level ("info");	55	(AnyEvent::Log::ctx "")->level ("info");
56		56
…		…
96	# creates a default package context object for the given package	96	# creates a default package context object for the given package
97	sub _pkg_ctx($) {	97	sub _pkg_ctx($) {
98	my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx";	98	my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx";
99		99
100	# link "parent" package	100	# link "parent" package
101	my $pkg = $_[0] =~ /^(.+)::/ ? $1 : "";	101	my $pkg = $_[0] =~ /^(.+)::/ ? $1 : "AE::Log::Top";
102		102
103	$pkg = $CTX{$pkg} \|\|= &_pkg_ctx ($pkg);	103	$pkg = $CTX{$pkg} \|\|= &_pkg_ctx ($pkg);
104	$ctx->[2]{$pkg+0} = $pkg;	104	$ctx->[2]{$pkg+0} = $pkg;
105		105
106	$ctx	106	$ctx
…		…
132	Note that you can (and should) call this function as C<AnyEvent::log> or	132	Note that you can (and should) call this function as C<AnyEvent::log> or
133	C<AE::log>, without C<use>-ing this module if possible (i.e. you don't	133	C<AE::log>, without C<use>-ing this module if possible (i.e. you don't
134	need any additional functionality), as those functions will load the	134	need any additional functionality), as those functions will load the
135	logging module on demand only. They are also much shorter to write.	135	logging module on demand only. They are also much shorter to write.
136		136
137	Also, if you otpionally generate a lot of debug messages (such as when	137	Also, if you optionally generate a lot of debug messages (such as when
138	tracing some code), you should look into using a logger callback and a	138	tracing some code), you should look into using a logger callback and a
139	boolean enabler (see C<logger>, below).	139	boolean enabler (see C<logger>, below).
140		140
141	Example: log something at error level.	141	Example: log something at error level.
142		142
…		…
173		173
174	our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);	174	our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
175		175
176	# time, ctx, level, msg	176	# time, ctx, level, msg
177	sub _format($$$$) {	177	sub _format($$$$) {
178	my $pfx = ft $_[0];	178	my $ts = ft $_[0];
		179	my $ct = " ";
		180
179	my @res;	181	my @res;
180		182
181	for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) {	183	for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) {
182	push @res, "$pfx $_\n";	184	push @res, "$ts$ct$_\n";
183	$pfx = "\t";	185	$ct = " + ";
184	}	186	}
185		187
186	join "", @res	188	join "", @res
187	}	189	}
188		190
189	sub _log {	191	sub _log {
190	my ($ctx, $level, $format, @args) = @_;	192	my ($ctx, $level, $format, @args) = @_;
191		193
		194	$level = $level > 0 && $level <= 9
		195	? $level+0
192	$level = $level > 0 && $level <= 9 ? $level+0 : $STR2LEVEL{$level} \|\| Carp::croak "$level: not a valid logging level, caught";	196	: $STR2LEVEL{$level} \|\| Carp::croak "$level: not a valid logging level, caught";
193		197
194	my $mask = 1 << $level;	198	my $mask = 1 << $level;
195		199
196	my (@ctx, $now, $fmt);	200	my (%seen, @ctx, $now, $fmt);
197		201
198	do {	202	do
		203	{
199	# skip if masked	204	# skip if masked
200	next unless $ctx->[1] & $mask;	205	if ($ctx->[1] & $mask && !$seen{$ctx+0}++) {
201
202	if ($ctx->[3]) {	206	if ($ctx->[3]) {
203	# logging target found	207	# logging target found
204		208
205	# now get raw message, unless we have it already	209	# now get raw message, unless we have it already
206	unless ($now) {	210	unless ($now) {
207	$format = $format->() if ref $format;	211	$format = $format->() if ref $format;
208	$format = sprintf $format, @args if @args;	212	$format = sprintf $format, @args if @args;
209	$format =~ s/\n$//;	213	$format =~ s/\n$//;
210	$now = AE::now;	214	$now = AE::now;
211	};	215	};
212		216
213	# format msg	217	# format msg
214	my $str = $ctx->[4]	218	my $str = $ctx->[4]
215	? $ctx->[4]($now, $_[0], $level, $format)	219	? $ctx->[4]($now, $_[0], $level, $format)
216	: $fmt \|\|= _format $now, $_[0], $level, $format;	220	: $fmt \|\|= _format $now, $_[0], $level, $format;
217		221
218	$ctx->[3]($str)	222	$ctx->[3]($str);
219	and next;	223	}
		224
		225	# not masked, not consumed - propagate to parent contexts
		226	push @ctx, values %{ $ctx->[2] };
		227	}
220	}	228	}
221
222	# not masked, not consume - propagate to parent contexts
223	push @ctx, values %{ $ctx->[2] };
224	} while $ctx = pop @ctx;	229	while $ctx = pop @ctx;
225		230
226	exit 1 if $level <= 1;	231	exit 1 if $level <= 1;
227	}	232	}
228		233
229	sub log($$;@) {	234	sub log($$;@) {
…		…
282	# re-assess logging status for all loggers	287	# re-assess logging status for all loggers
283	sub _reassess {	288	sub _reassess {
284	for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {	289	for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
285	my ($ctx, $level, $renabled) = @$_;	290	my ($ctx, $level, $renabled) = @$_;
286		291
287	# to detetc whether a message would be logged, we # actually	292	# to detect whether a message would be logged, we # actually
288	# try to log one and die. this isn't # fast, but we can be	293	# try to log one and die. this isn't fast, but we can be
289	# sure that the logging decision is correct :)	294	# sure that the logging decision is correct :)
290		295
291	$$renabled = !eval {	296	$$renabled = !eval {
292	local $SIG{__DIE__};	297	local $SIG{__DIE__};
293		298
…		…
356	For propagation, a context can have any number of attached I<parent	361	For propagation, a context can have any number of attached I<parent
357	contexts>. Any message that is neither masked by the logging mask nor	362	contexts>. Any message that is neither masked by the logging mask nor
358	masked by the logging callback returning true will be passed to all parent	363	masked by the logging callback returning true will be passed to all parent
359	contexts.	364	contexts.
360		365
		366	Each call to a logging function will log the message at most once per
		367	context, so it does not matter (much) if there are cycles or if the
		368	message can arrive at the same context via multiple paths.
		369
361	=head2 DEFAULTS	370	=head2 DEFAULTS
362		371
363	By default, all logging contexts have an full set of log levels ("all"), a	372	By default, all logging contexts have an full set of log levels ("all"), a
364	disabled logging callback and the default formatting callback.	373	disabled logging callback and the default formatting callback.
365		374
366	Package contexts have the package name as logging title by default.	375	Package contexts have the package name as logging title by default.
367		376
368	They have exactly one parent - the context of the "parent" package. The	377	They have exactly one parent - the context of the "parent" package. The
369	parent package is simply defined to be the package name without the last	378	parent package is simply defined to be the package name without the last
370	component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>,	379	component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>,
371	and C<AnyEvent> becomes the empty string.	380	and C<AnyEvent> becomes ... C<AnyEvent::Log::Top> which is the
		381	exception of the rule - just like the parent of any package name in
		382	Perl is C<main>, the default parent of any top-level package context is
		383	C<AnyEvent::Log::Top>.
372		384
373	Since perl packages form only an approximate hierarchy, this parent	385	Since perl packages form only an approximate hierarchy, this parent
374	context can of course be removed.	386	context can of course be removed.
375		387
376	All other (anonymous) contexts have no parents and an empty title by	388	All other (anonymous) contexts have no parents and an empty title by
377	default.	389	default.
378		390
379	When the module is first loaded, it configures the root context (the one	391	When the module is loaded it creates the default context called
380	with the empty string) to simply dump all log messages to C<STDERR>,	392	C<AnyEvent::Log::Default> (also stored in C<$AnyEvent::Log::Default>),
381	and sets it's log level set to all levels up to the one specified by	393	which simply logs everything to STDERR and doesn't propagate anything
382	C<$ENV{PERL_ANYEVENT_VERBOSE}>.	394	anywhere by default. The purpose of the default context is to provide
		395	a convenient place to override the global logging target or to attach
		396	additional log targets. It's not meant for filtering.
383		397
		398	It then creates the root context called C<AnyEvent::Log::Root> (also
		399	stored in C<$AnyEvent::Log::Root>) and sets its log level set to all
		400	levels up to the one specified by C<$ENV{PERL_ANYEVENT_VERBOSE}>. It
		401	then attached the default logging context to it. The purpose of the root
		402	context is to simply provide filtering according to some global log level.
		403
		404	Finally it creates the top-level package context called
		405	C<AnyEvent::Log::Top> (also stored in, you might have guessed,
		406	C<$AnyEvent::Log::Top>) and attached the root context but otherwise leaves
		407	it at default config. It's purpose is simply to collect all log messages
		408	system-wide.
		409
		410	These three special contexts can also be referred to by the
		411	package/context names C<AE::Log::Default>, C<AE::Log::Root> and
		412	C<AE::Log::Top>.
		413
384	The effect of all this is that log messages, by default, wander up to the	414	The effect of all this is that log messages, by default, wander up
385	root context and will be logged to STDERR if their log level is less than	415	to the root context where log messages with lower priority then
386	or equal to C<$ENV{PERL_ANYEVENT_VERBOSE}>.	416	C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered away and then to the
		417	AnyEvent::Log::Default context to be logged to STDERR.
387		418
		419	Splitting the top level context into three contexts makes it easy to set
		420	a global logging level (by modifying the root context), but still allow
		421	other contexts to log, for example, their debug and trace messages to the
		422	default target despite the global logging level, or to attach additional
		423	log targets that log messages, regardless of the global logging level.
		424
		425	It also makes it easy to replace the default STDERR-logger by something
		426	that logs to a file, or to attach additional logging targets.
		427
388	=head2 CREATING/FINDING A CONTEXT	428	=head2 CREATING/FINDING/DESTROYING CONTEXTS
389		429
390	=over 4	430	=over 4
391		431
392	=item $ctx = AnyEvent::Log::ctx [$pkg]	432	=item $ctx = AnyEvent::Log::ctx [$pkg]
393		433
…		…
411	: defined $pkg	451	: defined $pkg
412	? $CTX{$pkg} \|\|= AnyEvent::Log::_pkg_ctx $pkg	452	? $CTX{$pkg} \|\|= AnyEvent::Log::_pkg_ctx $pkg
413	: bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx"	453	: bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx"
414	}	454	}
415		455
416	# create default root context	456	=item AnyEvent::Log::reset
417	{	457
		458	Deletes all contexts and recreates the default hierarchy, i.e. resets the
		459	logging subsystem to defaults.
		460
		461	This can be used to implement config-file (re-)loading: before loading a
		462	configuration, reset all contexts.
		463
		464	=cut
		465
		466	sub reset {
		467	@$_ = () for values %CTX; # just to be sure - to kill circular logging dependencies
		468	%CTX = ();
		469
418	my $root = ctx undef;	470	my $default = ctx undef;
419	$root->[0] = "";	471	$default->title ("AnyEvent::Log::Default");
420	$root->title ("default");
421	$root->level ($AnyEvent::VERBOSE); undef $AnyEvent::VERBOSE;
422	$root->log_cb (sub {	472	$default->log_cb (sub {
423	print STDERR shift;	473	print STDERR shift;
424	0	474	0
425	});	475	});
426	$CTX{""} = $root;	476	$AnyEvent::Log::Default = $CTX{"AnyEvent::Log::Default"} = $CTX{"AE::Log::Default"} = $default;
427	}
428		477
429	=back	478	my $root = ctx undef;
		479	$root->title ("AnyEvent::Log::Root");
		480	$root->level ($AnyEvent::VERBOSE);
		481	$root->attach ($default);
		482	$AnyEvent::Log::Root = $CTX{"AnyEvent::Log::Root"} = $CTX{"AE::Log::Root"} = $root;
430		483
431	=cut	484	my $top = ctx undef;
		485	$top->title ("AnyEvent::Log::Top");
		486	$top->attach ($root);
		487	$AnyEvent::Log::Top = $CTX{"AnyEvent::Log::Top"} = $CTX{"AE::Log::Top"} = $top;
		488	}
		489
		490	AnyEvent::Log::reset;
		491
		492	# hello, CPAN, please catch me
		493	package AnyEvent::Log::Default;
		494	package AE::Log::Default;
		495	package AnyEvent::Log::Root;
		496	package AE::Log::Root;
		497	package AnyEvent::Log::Top;
		498	package AE::Log::Top;
432		499
433	package AnyEvent::Log::Ctx;	500	package AnyEvent::Log::Ctx;
434		501
435	# 0 1 2 3 4	502	# 0 1 2 3 4
436	# [$title, $level, %$parents, &$logcb, &$fmtcb]	503	# [$title, $level, %$parents, &$logcb, &$fmtcb]
		504
		505	=item $ctx = new AnyEvent::Log::Ctx methodname => param...
		506
		507	This is a convenience constructor that makes it simpler to construct
		508	anonymous logging contexts.
		509
		510	Each key-value pair results in an invocation of the method of the same
		511	name as the key with the value as parameter, unless the value is an
		512	arrayref, in which case it calls the method with the contents of the
		513	array. The methods are called in the same order as specified.
		514
		515	Example: create a new logging context and set both the default logging
		516	level, some parent contexts and a logging callback.
		517
		518	$ctx = new AnyEvent::Log::Ctx
		519	title => "dubious messages",
		520	level => "error",
		521	log_cb => sub { print STDOUT shift; 0 },
		522	parents => [$ctx1, $ctx, $ctx2],
		523	;
		524
		525	=back
		526
		527	=cut
		528
		529	sub new {
		530	my $class = shift;
		531
		532	my $ctx = AnyEvent::Log::ctx undef;
		533
		534	while (@_) {
		535	my ($k, $v) = splice @_, 0, 2;
		536	$ctx->$k (ref $v eq "ARRAY" ? @$v : $v);
		537	}
		538
		539	bless $ctx, $class # do we really support subclassing, hmm?
		540	}
		541
437		542
438	=head2 CONFIGURING A LOG CONTEXT	543	=head2 CONFIGURING A LOG CONTEXT
439		544
440	The following methods can be used to configure the logging context.	545	The following methods can be used to configure the logging context.
441		546
…		…
559	Removes the given parents from this context - it's not an error to attempt	664	Removes the given parents from this context - it's not an error to attempt
560	to remove a context that hasn't been added.	665	to remove a context that hasn't been added.
561		666
562	A context can be specified either as package name or as a context object.	667	A context can be specified either as package name or as a context object.
563		668
		669	=item $ctx->parents ($ctx2[, $ctx3...])
		670
		671	Replaces all parents attached to this context by the ones given.
		672
564	=cut	673	=cut
565		674
566	sub attach {	675	sub attach {
567	my $ctx = shift;	676	my $ctx = shift;
568		677
…		…
573	sub detach {	682	sub detach {
574	my $ctx = shift;	683	my $ctx = shift;
575		684
576	delete $ctx->[2]{$_+0}	685	delete $ctx->[2]{$_+0}
577	for map { AnyEvent::Log::ctx $_ } @_;	686	for map { AnyEvent::Log::ctx $_ } @_;
		687	}
		688
		689	sub parents {
		690	undef $_[0][2];
		691	&attach;
578	}	692	}
579		693
580	=back	694	=back
581		695
582	=head3 MESSAGE LOGGING	696	=head3 MESSAGE LOGGING
…		…
682		796
683	1;	797	1;
684		798
685	=back	799	=back
686		800
		801	=head1 EXAMPLES
		802
		803	This section shows some common configurations.
		804
		805	=over 4
		806
		807	=item Setting the global logging level.
		808
		809	Either put PERL_ANYEVENT_VERBOSE=<number> into your environment before
		810	running your program, or modify the log level of the root context:
		811
		812	PERL_ANYEVENT_VERBOSE=5 ./myprog
		813
		814	$AnyEvent::Log::Root->level ("warn");
		815
		816	=item Append all messages to a file instead of sending them to STDERR.
		817
		818	This is affected by the global logging level.
		819
		820	open my $fh, ">>", $path
		821	or die "$path: $!";
		822
		823	$AnyEvent::Log::Default->log_cb (sub {
		824	syswrite $fh, shift;
		825	0
		826	});
		827
		828	=item Write all messages with priority C<error> and higher to a file.
		829
		830	This writes them only when the global logging level allows it, because
		831	it is attached to the default context which is invoked I<after> global
		832	filtering.
		833
		834	open my $fh, ">>", $path
		835	or die "$path: $!";
		836
		837	$AnyEvent::Log::Default->attach (new AnyEvent::Log::Ctx
		838	log_cb => sub { syswrite $fh, shift; 0 });
		839
		840	This writes them regardless of the global logging level, because it is
		841	attached to the toplevel context, which receives all messages I<before>
		842	the global filtering.
		843
		844	$AnyEvent::Log::Top->attach (new AnyEvent::Log::Ctx
		845	log_cb => sub { syswrite $fh, shift; 0 });
		846
		847	In both cases, messages are still written to STDOUT.
		848
		849	=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
		850
		851	Attach the CyAnyEvent::Log::Default> context to the C<AnyEvent::Debug>
		852	context and increase the C<AnyEvent::Debug> logging level - this simply
		853	circumvents the global filtering for trace messages.
		854
		855	my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
		856	$debug->attach ($AnyEvent::Log::Default);
		857	$debug->levels ("trace"); # not "level"!
		858
		859	=back
		860
687	=head1 AUTHOR	861	=head1 AUTHOR
688		862
689	Marc Lehmann <schmorp@schmorp.de>	863	Marc Lehmann <schmorp@schmorp.de>
690	http://home.schmorp.de/	864	http://home.schmorp.de/
691		865

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents): Revision 1.10 by root, Fri Aug 19 21:17:08 2011 UTC vs. Revision 1.12 by root, Sat Aug 20 01:33:10 2011 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents):
Revision 1.10 by root, Fri Aug 19 21:17:08 2011 UTC vs.
Revision 1.12 by root, Sat Aug 20 01:33:10 2011 UTC