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

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.17 by root, Sat Aug 20 02:21:53 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.17 by root, Sat Aug 20 02:21:53 2011 UTC