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

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents):
Revision 1.3 by root, Wed Aug 17 02:02:38 2011 UTC vs.
Revision 1.15 by root, Sat Aug 20 02:16:59 2011 UTC

…		…
2		2
3	AnyEvent::Log - simple logging "framework"	3	AnyEvent::Log - simple logging "framework"
4		4
5	=head1 SYNOPSIS	5	=head1 SYNOPSIS
6		6
		7	# simple use
		8	use AnyEvent;
		9
		10	AE::log debug => "hit my knee";
		11	AE::log warn => "it's a bit too hot";
		12	AE::log error => "the flag was false!";
		13	AE::log fatal => "the bit toggled! run!";
		14
		15	# "complex" use
7	use AnyEvent::Log;	16	use AnyEvent::Log;
		17
		18	my $tracer = AnyEvent::Log::logger trace => \$my $trace;
		19
		20	$tracer->("i am here") if $trace;
		21	$tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
		22
		23	# configuration
		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);
8		40
9	=head1 DESCRIPTION	41	=head1 DESCRIPTION
10		42
11	This module implements a relatively simple "logging framework". It doesn't	43	This module implements a relatively simple "logging framework". It doesn't
12	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
13	AnyEvent - AnyEvent simply creates logging messages internally, and this	45	AnyEvent - AnyEvent simply creates logging messages internally, and this
14	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
15	using it from other modules as well.	47	using it from other modules as well.
16		48
17	Remember that the default verbosity level is C<0>, so nothing	49	Remember that the default verbosity level is C<0>, so nothing will be
18	will be logged, ever, unless you set C<$Anyvent::VERBOSE> or	50	logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number before
19	C<PERL_ANYEVENT_VERBOSE> to a higher number.	51	starting your program, or change the logging level at runtime with
		52	something like:
20		53
21	Possible future extensions are to allow custom log targets (where the	54	use AnyEvent;
22	level is an object), log filtering based on package, formatting, aliasing	55	(AnyEvent::Log::ctx "")->level ("info");
23	or package groups.
24		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
25	=head1 LOG FUNCTIONS	65	=head1 LOGGING FUNCTIONS
26		66
27	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
28	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
29	easily available as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent>	69	callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is
30	module is loaded.	70	loaded.
31		71
32	=over 4	72	=over 4
33		73
34	=cut	74	=cut
35		75
…		…
38	use Carp ();	78	use Carp ();
39	use POSIX ();	79	use POSIX ();
40		80
41	use AnyEvent (); BEGIN { AnyEvent::common_sense }	81	use AnyEvent (); BEGIN { AnyEvent::common_sense }
42	use AnyEvent::Util ();	82	use AnyEvent::Util ();
		83
		84	our $VERSION = $AnyEvent::VERSION;
43		85
44	our ($now_int, $now_str1, $now_str2);	86	our ($now_int, $now_str1, $now_str2);
45		87
46	# Format Time, not public - yet?	88	# Format Time, not public - yet?
47	sub ft($) {	89	sub ft($) {
…		…
52	if $now_int != $i;	94	if $now_int != $i;
53		95
54	"$now_str1$f$now_str2"	96	"$now_str1$f$now_str2"
55	}	97	}
56		98
57	our %CFG; #TODO	99	our %CTX; # all logging contexts
		100
		101	# creates a default package context object for the given package
		102	sub _pkg_ctx($) {
		103	my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx";
		104
		105	# link "parent" package
		106	my $pkg = $_[0] =~ /^(.+)::/ ? $1 : "AE::Log::Top";
		107
		108	$pkg = $CTX{$pkg} \|\|= &_pkg_ctx ($pkg);
		109	$ctx->[2]{$pkg+0} = $pkg;
		110
		111	$ctx
		112	}
58		113
59	=item AnyEvent::Log::log $level, $msg[, @args]	114	=item AnyEvent::Log::log $level, $msg[, @args]
60		115
61	Requests logging of the given C<$msg> with the given log level (1..9).	116	Requests logging of the given C<$msg> with the given log level (1..9).
62	You can also use the following strings as log level: C<fatal> (1),	117	You can also use the following strings as log level: C<fatal> (1),
…		…
78		133
79	Whether the given message will be logged depends on the maximum log level	134	Whether the given message will be logged depends on the maximum log level
80	and the caller's package.	135	and the caller's package.
81		136
82	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
83	C<AE::log>, without C<use>-ing this module if possible, as those functions	138	C<AE::log>, without C<use>-ing this module if possible (i.e. you don't
84	will laod the logging module on demand only.	139	need any additional functionality), as those functions will load the
		140	logging module on demand only. They are also much shorter to write.
		141
		142	Also, if you optionally generate a lot of debug messages (such as when
		143	tracing some code), you should look into using a logger callback and a
		144	boolean enabler (see C<logger>, below).
85		145
86	Example: log something at error level.	146	Example: log something at error level.
87		147
88	AE::log error => "something";	148	AE::log error => "something";
89		149
…		…
108	info => 7,	168	info => 7,
109	debug => 8,	169	debug => 8,
110	trace => 9,	170	trace => 9,
111	);	171	);
112		172
		173	sub now () { time }
		174
		175	AnyEvent::post_detect {
		176	*now = \&AE::now;
		177	};
		178
113	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);
114		180
		181	# time, ctx, level, msg
		182	sub _format($$$$) {
		183	my $ts = ft $_[0];
		184	my $ct = " ";
		185
		186	my @res;
		187
		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
		194	}
		195
115	sub _log {	196	sub _log {
116	my ($pkg, $targ, $msg, @args) = @_;	197	my ($ctx, $level, $format, @args) = @_;
117		198
118	my $level = ref $targ ? die "Can't use reference as logging level (yet)"	199	$level = $level > 0 && $level <= 9
119	: $targ > 0 && $targ <= 9 ? $targ+0	200	? $level+0
120	: $STR2LEVEL{$targ} \|\| Carp::croak "$targ: not a valid logging level, caught";	201	: $STR2LEVEL{$level} \|\| Carp::croak "$level: not a valid logging level, caught";
121		202
122	return if $level > $AnyEvent::VERBOSE;	203	my $mask = 1 << $level;
123		204
124	$msg = $msg->() if ref $msg;	205	my (%seen, @ctx, $now, $fmt);
125	$msg = sprintf $msg, @args if @args;
126	$msg =~ s/\n$//;
127		206
128	# now we have a message, log it	207	do
129	#TODO: could do LOTS of stuff here, and should, at least in some later version	208	{
		209	# skip if masked
		210	if ($ctx->[1] & $mask && !$seen{$ctx+0}++) {
		211	if ($ctx->[3]) {
		212	# logging target found
130		213
131	$msg = sprintf "%5s %s: %s", $LEVEL2STR[$level], $pkg, $msg;	214	# now get raw message, unless we have it already
132	my $pfx = ft AE::now;	215	unless ($now) {
		216	$format = $format->() if ref $format;
		217	$format = sprintf $format, @args if @args;
		218	$format =~ s/\n$//;
		219	$now = AE::now;
		220	};
133		221
134	for (split /\n/, $msg) {	222	# format msg
135	printf STDERR "$pfx $_\n";	223	my $str = $ctx->[4]
136	$pfx = "\t";	224	? $ctx->[4]($now, $_[0], $level, $format)
137	}	225	: $fmt \|\|= _format $now, $_[0], $level, $format;
		226
		227	$ctx->[3]($str);
		228	}
		229
		230	# not masked, not consumed - propagate to parent contexts
		231	push @ctx, values %{ $ctx->[2] };
		232	}
		233	}
		234	while $ctx = pop @ctx;
138		235
139	exit 1 if $level <= 1;	236	exit 1 if $level <= 1;
140	}	237	}
141		238
142	sub log($$;@) {	239	sub log($$;@) {
143	_log +(caller)[0], @_;	240	_log
		241	$CTX{ (caller)[0] } \|\|= _pkg_ctx +(caller)[0],
		242	@_;
144	}	243	}
145		244
146	AnyEvent::log = AE::log = \&log;	245	AnyEvent::log = AE::log = \&log;
147		246
148	=item $logger = AnyEvent::Log::logger $level[, \$enabled]	247	=item $logger = AnyEvent::Log::logger $level[, \$enabled]
…		…
191	our %LOGGER;	290	our %LOGGER;
192		291
193	# re-assess logging status for all loggers	292	# re-assess logging status for all loggers
194	sub _reassess {	293	sub _reassess {
195	for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {	294	for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
196	my ($pkg, $level, $renabled) = @$_;	295	my ($ctx, $level, $renabled) = @$_;
197		296
198	# to detetc whether a message would be logged, we # actually	297	# to detect whether a message would be logged, we # actually
199	# 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
200	# sure that the logging decision is correct :)	299	# sure that the logging decision is correct :)
201		300
202	$$renabled = !eval {	301	$$renabled = !eval {
203	local $SIG{__DIE__};	302	local $SIG{__DIE__};
204		303
205	_log $pkg, $level, sub { die };	304	_log $ctx, $level, sub { die };
206		305
207	1	306	1
208	};	307	};
209		308
210	$$renabled = 1; # TODO	309	$$renabled = 1; # TODO
211	}	310	}
212	}	311	}
213		312
214	sub logger($;$) {	313	sub _logger {
215	my ($level, $renabled) = @_;	314	my ($ctx, $level, $renabled) = @_;
216
217	$renabled \|\|= \my $enabled;
218	my $pkg = (caller)[0];
219		315
220	$$renabled = 1;	316	$$renabled = 1;
221		317
222	my $logger = [$pkg, $level, $renabled];	318	my $logger = [$ctx, $level, $renabled];
223		319
224	$LOGGER{$logger+0} = $logger;	320	$LOGGER{$logger+0} = $logger;
225		321
226	_reassess $logger+0;	322	_reassess $logger+0;
227		323
…		…
231	};	327	};
232		328
233	sub {	329	sub {
234	$guard if 0; # keep guard alive, but don't cause runtime overhead	330	$guard if 0; # keep guard alive, but don't cause runtime overhead
235		331
236	_log $pkg, $level, @_	332	_log $ctx, $level, @_
237	if $$renabled;	333	if $$renabled;
238	}	334	}
239	}	335	}
240		336
241	#TODO	337	sub logger($;$) {
		338	_logger
		339	$CTX{ (caller)[0] } \|\|= _pkg_ctx +(caller)[0],
		340	@_
		341	}
242		342
243	=back	343	=back
244		344
245	=head1 CONFIGURATION FUNCTIONALITY	345	=head1 LOGGING CONTEXTS
246		346
247	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.
		350
		351	A logging context has three major responsibilities: filtering, logging and
		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
248		432
249	=over 4	433	=over 4
250		434
		435	=item $ctx = AnyEvent::Log::ctx [$pkg]
		436
		437	This function creates or returns a logging context (which is an object).
		438
		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
		441	callers package is returned (i.e. the same context as a C<AE::log> call
		442	would use).
		443
		444	If C<undef> is given, then it creates a new anonymous context that is not
		445	tied to any package and is destroyed when no longer referenced.
		446
251	=cut	447	=cut
		448
		449	sub ctx(;$) {
		450	my $pkg = @_ ? shift : (caller)[0];
		451
		452	ref $pkg
		453	? $pkg
		454	: defined $pkg
		455	? $CTX{$pkg} \|\|= AnyEvent::Log::_pkg_ctx $pkg
		456	: bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx"
		457	}
		458
		459	=item AnyEvent::Log::reset
		460
		461	Resets all package contexts contexts and recreates the default hierarchy
		462	if necessary, i.e. resets the logging subsystem to defaults.
		463
		464	This can be used to implement config-file (re-)loading: before loading a
		465	configuration, reset all contexts.
		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;
		486	0
		487	});
		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;
		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;
		516
		517	package AnyEvent::Log::Ctx;
		518
		519	# 0 1 2 3 4
		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
		565
		566	=item $ctx->title ([$new_title])
		567
		568	Returns the title of the logging context - this is the package name, for
		569	package contexts, and a user defined string for all others.
		570
		571	If C<$new_title> is given, then it replaces the package name or title.
		572
		573	=cut
		574
		575	sub title {
		576	$_[0][0] = $_[1] if @_ > 1;
		577	$_[0][0]
		578	}
		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
		595	=item $ctx->levels ($level[, $level...)
		596
		597	Enables logging for the given levels and disables it for all others.
		598
		599	=item $ctx->level ($level)
		600
		601	Enables logging for the given level and all lower level (higher priority)
		602	ones. In addition to normal logging levels, specifying a level of C<0> or
		603	C<off> disables all logging for this level.
		604
		605	Example: log warnings, errors and higher priority messages.
		606
		607	$ctx->level ("warn");
		608	$ctx->level (5); # same thing, just numeric
		609
		610	=item $ctx->enable ($level[, $level...])
		611
		612	Enables logging for the given levels, leaving all others unchanged.
		613
		614	=item $ctx->disable ($level[, $level...])
		615
		616	Disables logging for the given levels, leaving all others unchanged.
		617
		618	=cut
		619
		620	sub _lvl_lst {
		621	map {
		622	$_ > 0 && $_ <= 9 ? $_+0
		623	: $_ eq "all" ? (1 .. 9)
		624	: $STR2LEVEL{$_} \|\| Carp::croak "$_: not a valid logging level, caught"
		625	} @_
		626	}
		627
		628	our $NOP_CB = sub { 0 };
		629
		630	sub levels {
		631	my $ctx = shift;
		632	$ctx->[1] = 0;
		633	$ctx->[1] \|= 1 << $_
		634	for &_lvl_lst;
		635	AnyEvent::Log::_reassess;
		636	}
		637
		638	sub level {
		639	my $ctx = shift;
		640	my $lvl = $_[0] =~ /^(?:0\|off\|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
		641
		642	$ctx->[1] = ((1 << $lvl) - 1) << 1;
		643	AnyEvent::Log::_reassess;
		644	}
		645
		646	sub enable {
		647	my $ctx = shift;
		648	$ctx->[1] \|= 1 << $_
		649	for &_lvl_lst;
		650	AnyEvent::Log::_reassess;
		651	}
		652
		653	sub disable {
		654	my $ctx = shift;
		655	$ctx->[1] &= ~(1 << $_)
		656	for &_lvl_lst;
		657	AnyEvent::Log::_reassess;
		658	}
		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
		672	=item $ctx->attach ($ctx2[, $ctx3...])
		673
		674	Attaches the given contexts as parents to this context. It is not an error
		675	to add a context twice (the second add will be ignored).
		676
		677	A context can be specified either as package name or as a context object.
		678
		679	=item $ctx->detach ($ctx2[, $ctx3...])
		680
		681	Removes the given parents from this context - it's not an error to attempt
		682	to remove a context that hasn't been added.
		683
		684	A context can be specified either as package name or as a context object.
		685
		686	=item $ctx->parents ($ctx2[, $ctx3...])
		687
		688	Replaces all parents attached to this context by the ones given.
		689
		690	=cut
		691
		692	sub attach {
		693	my $ctx = shift;
		694
		695	$ctx->[2]{$_+0} = $_
		696	for map { AnyEvent::Log::ctx $_ } @_;
		697	}
		698
		699	sub detach {
		700	my $ctx = shift;
		701
		702	delete $ctx->[2]{$_+0}
		703	for map { AnyEvent::Log::ctx $_ } @_;
		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
		721
		722	=item $ctx->log_cb ($cb->($str))
		723
		724	Replaces the logging callback on the context (C<undef> disables the
		725	logging callback).
		726
		727	The logging callback is responsible for handling formatted log messages
		728	(see C<fmt_cb> below) - normally simple text strings that end with a
		729	newline (and are possibly multiline themselves).
		730
		731	It also has to return true iff it has consumed the log message, and false
		732	if it hasn't. Consuming a message means that it will not be sent to any
		733	parent context. When in doubt, return C<0> from your logging callback.
		734
		735	Example: a very simple logging callback, simply dump the message to STDOUT
		736	and do not consume it.
		737
		738	$ctx->log_cb (sub { print STDERR shift; 0 });
		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
		751	=item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message))
		752
		753	Replaces the formatting callback on the context (C<undef> restores the
		754	default formatter).
		755
		756	The callback is passed the (possibly fractional) timestamp, the original
		757	logging context, the (numeric) logging level and the raw message string and needs to
		758	return a formatted log message. In most cases this will be a string, but
		759	it could just as well be an array reference that just stores the values.
		760
		761	Example: format just the raw message, with numeric log level in angle
		762	brackets.
		763
		764	$ctx->fmt_cb (sub {
		765	my ($time, $ctx, $lvl, $msg) = @_;
		766
		767	"<$lvl>$msg\n"
		768	});
		769
		770	Example: return an array reference with just the log values, and use
		771	C<PApp::SQL::sql_exec> to store the emssage in a database.
		772
		773	$ctx->fmt_cb (sub { \@_ });
		774	$ctx->log_cb (sub {
		775	my ($msg) = @_;
		776
		777	sql_exec "insert into log (when, subsys, prio, msg) values (?, ?, ?, ?)",
		778	$msg->[0] + 0,
		779	"$msg->[1]",
		780	$msg->[2] + 0,
		781	"$msg->[3]";
		782
		783	0
		784	});
		785
		786	=cut
		787
		788	sub log_cb {
		789	my ($ctx, $cb) = @_;
		790
		791	$ctx->[3] = $cb;
		792	}
		793
		794	sub fmt_cb {
		795	my ($ctx, $cb) = @_;
		796
		797	$ctx->[4] = $cb;
		798	}
		799
		800	=item $ctx->log ($level, $msg[, @params])
		801
		802	Same as C<AnyEvent::Log::log>, but uses the given context as log context.
		803
		804	=item $logger = $ctx->logger ($level[, \$enabled])
		805
		806	Same as C<AnyEvent::Log::logger>, but uses the given context as log
		807	context.
		808
		809	=cut
		810
		811	*log = \&AnyEvent::Log::_log;
		812	*logger = \&AnyEvent::Log::_logger;
252		813
253	1;	814	1;
		815
		816	=back
		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.
254		877
255	=back	878	=back
256		879
257	=head1 AUTHOR	880	=head1 AUTHOR
258		881

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents): Revision 1.3 by root, Wed Aug 17 02:02:38 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.3 by root, Wed Aug 17 02:02:38 2011 UTC vs.
Revision 1.15 by root, Sat Aug 20 02:16:59 2011 UTC