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

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents):
Revision 1.4 by root, Wed Aug 17 02:50:35 2011 UTC vs.
Revision 1.10 by root, Fri Aug 19 21:17:08 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, ever, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
19	C<PERL_ANYEVENT_VERBOSE> to a higher number.	51	before starting your program, or change the logging level at runtime wiht
		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
25	=head1 LOG FUNCTIONS	62	=head1 LOGGING FUNCTIONS
26		63
27	These functions allow you to log messages. They always use the caller's	64	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	65	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>	66	callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is
30	module is loaded.	67	loaded.
31		68
32	=over 4	69	=over 4
33		70
34	=cut	71	=cut
35		72
…		…
52	if $now_int != $i;	89	if $now_int != $i;
53		90
54	"$now_str1$f$now_str2"	91	"$now_str1$f$now_str2"
55	}	92	}
56		93
57	our %CFG; #TODO	94	our %CTX; # all logging contexts
		95
		96	# creates a default package context object for the given package
		97	sub _pkg_ctx($) {
		98	my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx";
		99
		100	# link "parent" package
		101	my $pkg = $_[0] =~ /^(.+)::/ ? $1 : "";
		102
		103	$pkg = $CTX{$pkg} \|\|= &_pkg_ctx ($pkg);
		104	$ctx->[2]{$pkg+0} = $pkg;
		105
		106	$ctx
		107	}
58		108
59	=item AnyEvent::Log::log $level, $msg[, @args]	109	=item AnyEvent::Log::log $level, $msg[, @args]
60		110
61	Requests logging of the given C<$msg> with the given log level (1..9).	111	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),	112	You can also use the following strings as log level: C<fatal> (1),
…		…
78		128
79	Whether the given message will be logged depends on the maximum log level	129	Whether the given message will be logged depends on the maximum log level
80	and the caller's package.	130	and the caller's package.
81		131
82	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
83	C<AE::log>, without C<use>-ing this module if possible, as those functions	133	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.	134	need any additional functionality), as those functions will load the
		135	logging module on demand only. They are also much shorter to write.
		136
		137	Also, if you otpionally generate a lot of debug messages (such as when
		138	tracing some code), you should look into using a logger callback and a
		139	boolean enabler (see C<logger>, below).
85		140
86	Example: log something at error level.	141	Example: log something at error level.
87		142
88	AE::log error => "something";	143	AE::log error => "something";
89		144
…		…
109	debug => 8,	164	debug => 8,
110	trace => 9,	165	trace => 9,
111	);	166	);
112		167
113	sub now () { time }	168	sub now () { time }
		169
114	AnyEvent::post_detect {	170	AnyEvent::post_detect {
115	*now = \&AE::now;	171	*now = \&AE::now;
116	};	172	};
117		173
118	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);
119		175
120	sub _log {	176	# time, ctx, level, msg
121	my ($pkg, $targ, $msg, @args) = @_;	177	sub _format($$$$) {
122
123	my $level = ref $targ ? die "Can't use reference as logging level (yet)"
124	: $targ > 0 && $targ <= 9 ? $targ+0
125	: $STR2LEVEL{$targ} \|\| Carp::croak "$targ: not a valid logging level, caught";
126
127	#TODO: find actual targets, see if we even have to log
128
129	return unless $level <= $AnyEvent::VERBOSE;
130
131	$msg = $msg->() if ref $msg;
132	$msg = sprintf $msg, @args if @args;
133	$msg =~ s/\n$//;
134
135	# now we have a message, log it
136
137	# TODO: writers/processors/filters/formatters?
138
139	$msg = sprintf "%-5s %s: %s", $LEVEL2STR[$level], $pkg, $msg;
140	my $pfx = ft now;	178	my $pfx = ft $_[0];
		179	my @res;
141		180
142	for (split /\n/, $msg) {	181	for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) {
143	printf STDERR "$pfx $_\n";	182	push @res, "$pfx $_\n";
144	$pfx = "\t";	183	$pfx = "\t";
145	}	184	}
146		185
		186	join "", @res
		187	}
		188
		189	sub _log {
		190	my ($ctx, $level, $format, @args) = @_;
		191
		192	$level = $level > 0 && $level <= 9 ? $level+0 : $STR2LEVEL{$level} \|\| Carp::croak "$level: not a valid logging level, caught";
		193
		194	my $mask = 1 << $level;
		195
		196	my (@ctx, $now, $fmt);
		197
		198	do {
		199	# skip if masked
		200	next unless $ctx->[1] & $mask;
		201
		202	if ($ctx->[3]) {
		203	# logging target found
		204
		205	# now get raw message, unless we have it already
		206	unless ($now) {
		207	$format = $format->() if ref $format;
		208	$format = sprintf $format, @args if @args;
		209	$format =~ s/\n$//;
		210	$now = AE::now;
		211	};
		212
		213	# format msg
		214	my $str = $ctx->[4]
		215	? $ctx->[4]($now, $_[0], $level, $format)
		216	: $fmt \|\|= _format $now, $_[0], $level, $format;
		217
		218	$ctx->[3]($str)
		219	and next;
		220	}
		221
		222	# not masked, not consume - propagate to parent contexts
		223	push @ctx, values %{ $ctx->[2] };
		224	} while $ctx = pop @ctx;
		225
147	exit 1 if $level <= 1;	226	exit 1 if $level <= 1;
148	}	227	}
149		228
150	sub log($$;@) {	229	sub log($$;@) {
151	_log +(caller)[0], @_;	230	_log
		231	$CTX{ (caller)[0] } \|\|= _pkg_ctx +(caller)[0],
		232	@_;
152	}	233	}
153		234
154	AnyEvent::log = AE::log = \&log;	235	AnyEvent::log = AE::log = \&log;
155		236
156	=item $logger = AnyEvent::Log::logger $level[, \$enabled]	237	=item $logger = AnyEvent::Log::logger $level[, \$enabled]
…		…
199	our %LOGGER;	280	our %LOGGER;
200		281
201	# re-assess logging status for all loggers	282	# re-assess logging status for all loggers
202	sub _reassess {	283	sub _reassess {
203	for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {	284	for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
204	my ($pkg, $level, $renabled) = @$_;	285	my ($ctx, $level, $renabled) = @$_;
205		286
206	# to detetc whether a message would be logged, we # actually	287	# to detetc whether a message would be logged, we # actually
207	# try to log one and die. this isn't # fast, but we can be	288	# try to log one and die. this isn't # fast, but we can be
208	# sure that the logging decision is correct :)	289	# sure that the logging decision is correct :)
209		290
210	$$renabled = !eval {	291	$$renabled = !eval {
211	local $SIG{__DIE__};	292	local $SIG{__DIE__};
212		293
213	_log $pkg, $level, sub { die };	294	_log $ctx, $level, sub { die };
214		295
215	1	296	1
216	};	297	};
217		298
218	$$renabled = 1; # TODO	299	$$renabled = 1; # TODO
219	}	300	}
220	}	301	}
221		302
222	sub logger($;$) {	303	sub _logger($;$) {
223	my ($level, $renabled) = @_;	304	my ($ctx, $level, $renabled) = @_;
224		305
225	$renabled \|\|= \my $enabled;	306	$renabled \|\|= \my $enabled;
226	my $pkg = (caller)[0];
227		307
228	$$renabled = 1;	308	$$renabled = 1;
229		309
230	my $logger = [$pkg, $level, $renabled];	310	my $logger = [$ctx, $level, $renabled];
231		311
232	$LOGGER{$logger+0} = $logger;	312	$LOGGER{$logger+0} = $logger;
233		313
234	_reassess $logger+0;	314	_reassess $logger+0;
235		315
…		…
239	};	319	};
240		320
241	sub {	321	sub {
242	$guard if 0; # keep guard alive, but don't cause runtime overhead	322	$guard if 0; # keep guard alive, but don't cause runtime overhead
243		323
244	_log $pkg, $level, @_	324	_log $ctx, $level, @_
245	if $$renabled;	325	if $$renabled;
246	}	326	}
247	}	327	}
248		328
249	#TODO	329	sub logger($;$) {
		330	_logger
		331	$CTX{ (caller)[0] } \|\|= _pkg_ctx +(caller)[0],
		332	@_
		333	}
250		334
251	=back	335	=back
252		336
253	=head1 CONFIGURATION FUNCTIONALITY	337	=head1 LOGGING CONTEXTS
254		338
255	None, yet, except for C<PERL_ANYEVENT_VERBOSE>, described in the L<AnyEvent> manpage.	339	This module associates every log message with a so-called I<logging
		340	context>, based on the package of the caller. Every perl package has its
		341	own logging context.
		342
		343	A logging context has three major responsibilities: filtering, logging and
		344	propagating the message.
		345
		346	For the first purpose, filtering, each context has a set of logging
		347	levels, called the log level mask. Messages not in the set will be ignored
		348	by this context (masked).
		349
		350	For logging, the context stores a formatting callback (which takes the
		351	timestamp, context, level and string message and formats it in the way
		352	it should be logged) and a logging callback (which is responsible for
		353	actually logging the formatted message and telling C<AnyEvent::Log>
		354	whether it has consumed the message, or whether it should be propagated).
		355
		356	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
		358	masked by the logging callback returning true will be passed to all parent
		359	contexts.
		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 the empty string.
		372
		373	Since perl packages form only an approximate hierarchy, this parent
		374	context can of course be removed.
		375
		376	All other (anonymous) contexts have no parents and an empty title by
		377	default.
		378
		379	When the module is first loaded, it configures the root context (the one
		380	with the empty string) to simply dump all log messages to C<STDERR>,
		381	and sets it's log level set to all levels up to the one specified by
		382	C<$ENV{PERL_ANYEVENT_VERBOSE}>.
		383
		384	The effect of all this is that log messages, by default, wander up to the
		385	root context and will be logged to STDERR if their log level is less than
		386	or equal to C<$ENV{PERL_ANYEVENT_VERBOSE}>.
		387
		388	=head2 CREATING/FINDING A CONTEXT
256		389
257	=over 4	390	=over 4
258		391
		392	=item $ctx = AnyEvent::Log::ctx [$pkg]
		393
		394	This function creates or returns a logging context (which is an object).
		395
		396	If a package name is given, then the context for that packlage is
		397	returned. If it is called without any arguments, then the context for the
		398	callers package is returned (i.e. the same context as a C<AE::log> call
		399	would use).
		400
		401	If C<undef> is given, then it creates a new anonymous context that is not
		402	tied to any package and is destroyed when no longer referenced.
		403
259	=cut	404	=cut
		405
		406	sub ctx(;$) {
		407	my $pkg = @_ ? shift : (caller)[0];
		408
		409	ref $pkg
		410	? $pkg
		411	: defined $pkg
		412	? $CTX{$pkg} \|\|= AnyEvent::Log::_pkg_ctx $pkg
		413	: bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx"
		414	}
		415
		416	# create default root context
		417	{
		418	my $root = ctx undef;
		419	$root->[0] = "";
		420	$root->title ("default");
		421	$root->level ($AnyEvent::VERBOSE); undef $AnyEvent::VERBOSE;
		422	$root->log_cb (sub {
		423	print STDERR shift;
		424	0
		425	});
		426	$CTX{""} = $root;
		427	}
		428
		429	=back
		430
		431	=cut
		432
		433	package AnyEvent::Log::Ctx;
		434
		435	# 0 1 2 3 4
		436	# [$title, $level, %$parents, &$logcb, &$fmtcb]
		437
		438	=head2 CONFIGURING A LOG CONTEXT
		439
		440	The following methods can be used to configure the logging context.
		441
		442	=over 4
		443
		444	=item $ctx->title ([$new_title])
		445
		446	Returns the title of the logging context - this is the package name, for
		447	package contexts, and a user defined string for all others.
		448
		449	If C<$new_title> is given, then it replaces the package name or title.
		450
		451	=cut
		452
		453	sub title {
		454	$_[0][0] = $_[1] if @_ > 1;
		455	$_[0][0]
		456	}
		457
		458	=back
		459
		460	=head3 LOGGING LEVELS
		461
		462	The following methods deal with the logging level set associated with the
		463	log context.
		464
		465	The most common method to use is probably C<< $ctx->level ($level) >>,
		466	which configures the specified and any higher priority levels.
		467
		468	All functions which accept a list of levels also accept the special string
		469	C<all> which expands to all logging levels.
		470
		471	=over 4
		472
		473	=item $ctx->levels ($level[, $level...)
		474
		475	Enables logging for the given levels and disables it for all others.
		476
		477	=item $ctx->level ($level)
		478
		479	Enables logging for the given level and all lower level (higher priority)
		480	ones. In addition to normal logging levels, specifying a level of C<0> or
		481	C<off> disables all logging for this level.
		482
		483	Example: log warnings, errors and higher priority messages.
		484
		485	$ctx->level ("warn");
		486	$ctx->level (5); # same thing, just numeric
		487
		488	=item $ctx->enable ($level[, $level...])
		489
		490	Enables logging for the given levels, leaving all others unchanged.
		491
		492	=item $ctx->disable ($level[, $level...])
		493
		494	Disables logging for the given levels, leaving all others unchanged.
		495
		496	=cut
		497
		498	sub _lvl_lst {
		499	map {
		500	$_ > 0 && $_ <= 9 ? $_+0
		501	: $_ eq "all" ? (1 .. 9)
		502	: $STR2LEVEL{$_} \|\| Carp::croak "$_: not a valid logging level, caught"
		503	} @_
		504	}
		505
		506	our $NOP_CB = sub { 0 };
		507
		508	sub levels {
		509	my $ctx = shift;
		510	$ctx->[1] = 0;
		511	$ctx->[1] \|= 1 << $_
		512	for &_lvl_lst;
		513	AnyEvent::Log::_reassess;
		514	}
		515
		516	sub level {
		517	my $ctx = shift;
		518	my $lvl = $_[0] =~ /^(?:0\|off\|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
		519
		520	$ctx->[1] = ((1 << $lvl) - 1) << 1;
		521	AnyEvent::Log::_reassess;
		522	}
		523
		524	sub enable {
		525	my $ctx = shift;
		526	$ctx->[1] \|= 1 << $_
		527	for &_lvl_lst;
		528	AnyEvent::Log::_reassess;
		529	}
		530
		531	sub disable {
		532	my $ctx = shift;
		533	$ctx->[1] &= ~(1 << $_)
		534	for &_lvl_lst;
		535	AnyEvent::Log::_reassess;
		536	}
		537
		538	=back
		539
		540	=head3 PARENT CONTEXTS
		541
		542	The following methods attach and detach another logging context to a
		543	logging context.
		544
		545	Log messages are propagated to all parent contexts, unless the logging
		546	callback consumes the message.
		547
		548	=over 4
		549
		550	=item $ctx->attach ($ctx2[, $ctx3...])
		551
		552	Attaches the given contexts as parents to this context. It is not an error
		553	to add a context twice (the second add will be ignored).
		554
		555	A context can be specified either as package name or as a context object.
		556
		557	=item $ctx->detach ($ctx2[, $ctx3...])
		558
		559	Removes the given parents from this context - it's not an error to attempt
		560	to remove a context that hasn't been added.
		561
		562	A context can be specified either as package name or as a context object.
		563
		564	=cut
		565
		566	sub attach {
		567	my $ctx = shift;
		568
		569	$ctx->[2]{$_+0} = $_
		570	for map { AnyEvent::Log::ctx $_ } @_;
		571	}
		572
		573	sub detach {
		574	my $ctx = shift;
		575
		576	delete $ctx->[2]{$_+0}
		577	for map { AnyEvent::Log::ctx $_ } @_;
		578	}
		579
		580	=back
		581
		582	=head3 MESSAGE LOGGING
		583
		584	The following methods configure how the logging context actually does
		585	the logging (which consists of formatting the message and printing it or
		586	whatever it wants to do with it) and also allows you to log messages
		587	directly to a context, without going via your package context.
		588
		589	=over 4
		590
		591	=item $ctx->log_cb ($cb->($str))
		592
		593	Replaces the logging callback on the context (C<undef> disables the
		594	logging callback).
		595
		596	The logging callback is responsible for handling formatted log messages
		597	(see C<fmt_cb> below) - normally simple text strings that end with a
		598	newline (and are possibly multiline themselves).
		599
		600	It also has to return true iff it has consumed the log message, and false
		601	if it hasn't. Consuming a message means that it will not be sent to any
		602	parent context. When in doubt, return C<0> from your logging callback.
		603
		604	Example: a very simple logging callback, simply dump the message to STDOUT
		605	and do not consume it.
		606
		607	$ctx->log_cb (sub { print STDERR shift; 0 });
		608
		609	You can filter messages by having a log callback that simply returns C<1>
		610	and does not do anything with the message, but this counts as "message
		611	being logged" and might not be very efficient.
		612
		613	Example: propagate all messages except for log levels "debug" and
		614	"trace". The messages will still be generated, though, which can slow down
		615	your program.
		616
		617	$ctx->levels ("debug", "trace");
		618	$ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
		619
		620	=item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message))
		621
		622	Replaces the formatting callback on the context (C<undef> restores the
		623	default formatter).
		624
		625	The callback is passed the (possibly fractional) timestamp, the original
		626	logging context, the (numeric) logging level and the raw message string and needs to
		627	return a formatted log message. In most cases this will be a string, but
		628	it could just as well be an array reference that just stores the values.
		629
		630	Example: format just the raw message, with numeric log level in angle
		631	brackets.
		632
		633	$ctx->fmt_cb (sub {
		634	my ($time, $ctx, $lvl, $msg) = @_;
		635
		636	"<$lvl>$msg\n"
		637	});
		638
		639	Example: return an array reference with just the log values, and use
		640	C<PApp::SQL::sql_exec> to store the emssage in a database.
		641
		642	$ctx->fmt_cb (sub { \@_ });
		643	$ctx->log_cb (sub {
		644	my ($msg) = @_;
		645
		646	sql_exec "insert into log (when, subsys, prio, msg) values (?, ?, ?, ?)",
		647	$msg->[0] + 0,
		648	"$msg->[1]",
		649	$msg->[2] + 0,
		650	"$msg->[3]";
		651
		652	0
		653	});
		654
		655	=cut
		656
		657	sub log_cb {
		658	my ($ctx, $cb) = @_;
		659
		660	$ctx->[3] = $cb;
		661	}
		662
		663	sub fmt_cb {
		664	my ($ctx, $cb) = @_;
		665
		666	$ctx->[4] = $cb;
		667	}
		668
		669	=item $ctx->log ($level, $msg[, @params])
		670
		671	Same as C<AnyEvent::Log::log>, but uses the given context as log context.
		672
		673	=item $logger = $ctx->logger ($level[, \$enabled])
		674
		675	Same as C<AnyEvent::Log::logger>, but uses the given context as log
		676	context.
		677
		678	=cut
		679
		680	*log = \&AnyEvent::Log::_log;
		681	*logger = \&AnyEvent::Log::_logger;
260		682
261	1;	683	1;
262		684
263	=back	685	=back
264		686

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents): Revision 1.4 by root, Wed Aug 17 02:50:35 2011 UTC vs. Revision 1.10 by root, Fri Aug 19 21:17:08 2011 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents):
Revision 1.4 by root, Wed Aug 17 02:50:35 2011 UTC vs.
Revision 1.10 by root, Fri Aug 19 21:17:08 2011 UTC