[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.8 by root, Fri Aug 19 19:20:36 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	#TODO: config
		24	#TODO: ctx () becomes caller[0]...
8		25
9	=head1 DESCRIPTION	26	=head1 DESCRIPTION
10		27
11	This module implements a relatively simple "logging framework". It doesn't	28	This module implements a relatively simple "logging framework". It doesn't
12	attempt to be "the" logging solution or even "a" logging solution for	29	attempt to be "the" logging solution or even "a" logging solution for
13	AnyEvent - AnyEvent simply creates logging messages internally, and this	30	AnyEvent - AnyEvent simply creates logging messages internally, and this
14	module more or less exposes the mechanism, with some extra spiff to allow	31	module more or less exposes the mechanism, with some extra spiff to allow
15	using it from other modules as well.	32	using it from other modules as well.
16		33
17	Remember that the default verbosity level is C<0>, so nothing	34	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	35	logged, ever, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
19	C<PERL_ANYEVENT_VERBOSE> to a higher number.	36	before starting your program.#TODO
20		37
21	Possible future extensions are to allow custom log targets (where the	38	Possible future extensions are to allow custom log targets (where the
22	level is an object), log filtering based on package, formatting, aliasing	39	level is an object), log filtering based on package, formatting, aliasing
23	or package groups.	40	or package groups.
24		41
25	=head1 LOG FUNCTIONS	42	=head1 LOG FUNCTIONS
26		43
27	These functions allow you to log messages. They always use the caller's	44	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	45	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>	46	callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is
30	module is loaded.	47	loaded.
31		48
32	=over 4	49	=over 4
33		50
34	=cut	51	=cut
35		52
…		…
52	if $now_int != $i;	69	if $now_int != $i;
53		70
54	"$now_str1$f$now_str2"	71	"$now_str1$f$now_str2"
55	}	72	}
56		73
57	our %CFG; #TODO	74	our %CTX; # all logging contexts
		75
		76	my $default_log_cb = sub { 0 };
		77
		78	# creates a default package context object for the given package
		79	sub _pkg_ctx($) {
		80	my $ctx = bless [$_[0], 0, {}, $default_log_cb], "AnyEvent::Log::Ctx";
		81
		82	# link "parent" package
		83	my $pkg = $_[0] =~ /^(.+)::/ ? $1 : "";
		84
		85	$pkg = $CTX{$pkg} \|\|= &_pkg_ctx ($pkg);
		86	$ctx->[2]{$pkg+0} = $pkg;
		87
		88	$ctx
		89	}
58		90
59	=item AnyEvent::Log::log $level, $msg[, @args]	91	=item AnyEvent::Log::log $level, $msg[, @args]
60		92
61	Requests logging of the given C<$msg> with the given log level (1..9).	93	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),	94	You can also use the following strings as log level: C<fatal> (1),
…		…
78		110
79	Whether the given message will be logged depends on the maximum log level	111	Whether the given message will be logged depends on the maximum log level
80	and the caller's package.	112	and the caller's package.
81		113
82	Note that you can (and should) call this function as C<AnyEvent::log> or	114	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	115	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.	116	need any additional functionality), as those functions will load the
		117	logging module on demand only. They are also much shorter to write.
		118
		119	Also, if you otpionally generate a lot of debug messages (such as when
		120	tracing some code), you should look into using a logger callback and a
		121	boolean enabler (see C<logger>, below).
85		122
86	Example: log something at error level.	123	Example: log something at error level.
87		124
88	AE::log error => "something";	125	AE::log error => "something";
89		126
…		…
108	info => 7,	145	info => 7,
109	debug => 8,	146	debug => 8,
110	trace => 9,	147	trace => 9,
111	);	148	);
112		149
		150	sub now () { time }
		151	AnyEvent::post_detect {
		152	*now = \&AE::now;
		153	};
		154
113	our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);	155	our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
114		156
		157	# time, ctx, level, msg
		158	sub _format($$$$) {
		159	my $pfx = ft $_[0];
		160
		161	join "",
		162	map "$pfx $_\n",
		163	split /\n/,
		164	sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]
		165	}
		166
115	sub _log {	167	sub _log {
116	my ($pkg, $targ, $msg, @args) = @_;	168	my ($ctx, $level, $format, @args) = @_;
117		169
118	my $level = ref $targ ? die "Can't use reference as logging level (yet)"	170	$level = $level > 0 && $level <= 9 ? $level+0 : $STR2LEVEL{$level} \|\| Carp::croak "$level: not a valid logging level, caught";
119	: $targ > 0 && $targ <= 9 ? $targ+0
120	: $STR2LEVEL{$targ} \|\| Carp::croak "$targ: not a valid logging level, caught";
121		171
122	return if $level > $AnyEvent::VERBOSE;	172	my $mask = 1 << $level;
123
124	$msg = $msg->() if ref $msg;
125	$msg = sprintf $msg, @args if @args;
126	$msg =~ s/\n$//;
127
128	# now we have a message, log it
129	#TODO: could do LOTS of stuff here, and should, at least in some later version
130
131	$msg = sprintf "%5s %s: %s", $LEVEL2STR[$level], $pkg, $msg;
132	my $pfx = ft AE::now;	173	my $now = AE::now;
133		174
134	for (split /\n/, $msg) {	175	my (@ctx, $did_format, $fmt);
135	printf STDERR "$pfx $_\n";	176
136	$pfx = "\t";	177	do {
137	}	178	if ($ctx->[1] & $mask) {
		179	# logging target found
		180
		181	# get raw message
		182	unless ($did_format) {
		183	$format = $format->() if ref $format;
		184	$format = sprintf $format, @args if @args;
		185	$format =~ s/\n$//;
		186	$did_format = 1;
		187	};
		188
		189	# format msg
		190	my $str = $ctx->[4]
		191	? $ctx->[4]($now, $_[0], $level, $format)
		192	: $fmt \|\|= _format $now, $_[0], $level, $format;
		193
		194	$ctx->[3]($str)
		195	and next;
		196	}
		197
		198	# not consume - push parent contexts
		199	push @ctx, values %{ $ctx->[2] };
		200	} while $ctx = pop @ctx;
138		201
139	exit 1 if $level <= 1;	202	exit 1 if $level <= 1;
140	}	203	}
141		204
142	sub log($$;@) {	205	sub log($$;@) {
143	_log +(caller)[0], @_;	206	_log
		207	$CTX{ (caller)[0] } \|\|= _pkg_ctx +(caller)[0],
		208	@_;
144	}	209	}
145		210
146	AnyEvent::log = AE::log = \&log;	211	AnyEvent::log = AE::log = \&log;
147		212
148	=item $logger = AnyEvent::Log::logger $level[, \$enabled]	213	=item $logger = AnyEvent::Log::logger $level[, \$enabled]
…		…
191	our %LOGGER;	256	our %LOGGER;
192		257
193	# re-assess logging status for all loggers	258	# re-assess logging status for all loggers
194	sub _reassess {	259	sub _reassess {
195	for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {	260	for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
196	my ($pkg, $level, $renabled) = @$_;	261	my ($ctx, $level, $renabled) = @$_;
197		262
198	# to detetc whether a message would be logged, we # actually	263	# to detetc whether a message would be logged, we # actually
199	# try to log one and die. this isn't # fast, but we can be	264	# try to log one and die. this isn't # fast, but we can be
200	# sure that the logging decision is correct :)	265	# sure that the logging decision is correct :)
201		266
202	$$renabled = !eval {	267	$$renabled = !eval {
203	local $SIG{__DIE__};	268	local $SIG{__DIE__};
204		269
205	_log $pkg, $level, sub { die };	270	_log $ctx, $level, sub { die };
206		271
207	1	272	1
208	};	273	};
209		274
210	$$renabled = 1; # TODO	275	$$renabled = 1; # TODO
211	}	276	}
212	}	277	}
213		278
214	sub logger($;$) {	279	sub _logger($;$) {
215	my ($level, $renabled) = @_;	280	my ($ctx, $level, $renabled) = @_;
216		281
217	$renabled \|\|= \my $enabled;	282	$renabled \|\|= \my $enabled;
218	my $pkg = (caller)[0];
219		283
220	$$renabled = 1;	284	$$renabled = 1;
221		285
222	my $logger = [$pkg, $level, $renabled];	286	my $logger = [$ctx, $level, $renabled];
223		287
224	$LOGGER{$logger+0} = $logger;	288	$LOGGER{$logger+0} = $logger;
225		289
226	_reassess $logger+0;	290	_reassess $logger+0;
227		291
…		…
231	};	295	};
232		296
233	sub {	297	sub {
234	$guard if 0; # keep guard alive, but don't cause runtime overhead	298	$guard if 0; # keep guard alive, but don't cause runtime overhead
235		299
236	_log $pkg, $level, @_	300	_log $ctx, $level, @_
237	if $$renabled;	301	if $$renabled;
238	}	302	}
239	}	303	}
240		304
		305	sub logger($;$) {
		306	_logger
		307	$CTX{ (caller)[0] } \|\|= _pkg_ctx +(caller)[0],
		308	@_
		309	}
		310
241	#TODO	311	#TODO
242		312
243	=back	313	=back
244		314
245	=head1 CONFIGURATION FUNCTIONALITY	315	=head1 CONFIGURATION FUNCTIONALITY
246		316
247	None, yet, except for C<PERL_ANYEVENT_VERBOSE>, described in the L<AnyEvent> manpage.	317	None, yet, except for C<PERL_ANYEVENT_VERBOSE>, described in the L<AnyEvent> manpage.
248		318
		319	#TODO: wahst a context
		320	#TODO
		321
249	=over 4	322	=over 4
250		323
		324	=item $ctx = AnyEvent::Log::ctx [$pkg]
		325
		326	Returns a I<config> object for the given package name.
		327
		328	If no package name is given, returns the context for the current perl
		329	package (i.e. the same context as a C<AE::log> call would use).
		330
		331	If C<undef> is given, then it creates a new anonymous context that is not
		332	tied to any package and is destroyed when no longer referenced.
		333
251	=cut	334	=cut
		335
		336	sub ctx(;$) {
		337	my $pkg = @_ ? shift : (caller)[0];
		338
		339	ref $pkg
		340	? $pkg
		341	: defined $pkg
		342	? $CTX{$pkg} \|\|= AnyEvent::Log::_pkg_ctx $pkg
		343	: bless [undef, 0, undef, $default_log_cb], "AnyEvent::Log::Ctx"
		344	}
		345
		346	# create default root context
		347	{
		348	my $root = ctx undef;
		349	$root->[0] = "";
		350	$root->title ("default");
		351	$root->level ($AnyEvent::VERBOSE);
		352	$root->log_cb (sub {
		353	print STDERR shift;
		354	0
		355	});
		356	$CTX{""} = $root;
		357	}
		358
		359	package AnyEvent::Log::Ctx;
		360
		361	# 0 1 2 3 4
		362	# [$title, $level, %$parents, &$logcb, &$fmtcb]
		363
		364	=item $ctx->title ([$new_title])
		365
		366	Returns the title of the logging context - this is the package name, for
		367	package contexts, and a user defined string for all others.
		368
		369	If C<$new_title> is given, then it replaces the package name or title.
		370
		371	=cut
		372
		373	sub title {
		374	$_[0][0] = $_[1] if @_ > 1;
		375	$_[0][0]
		376	}
		377
		378	=item $ctx->levels ($level[, $level...)
		379
		380	Enables logging fot the given levels and disables it for all others.
		381
		382	=item $ctx->level ($level)
		383
		384	Enables logging for the given level and all lower level (higher priority)
		385	ones. Specifying a level of C<0> or C<off> disables all logging for this
		386	level.
		387
		388	Example: log warnings, errors and higher priority messages.
		389
		390	$ctx->level ("warn");
		391	$ctx->level (5); # same thing, just numeric
		392
		393	=item $ctx->enable ($level[, $level...])
		394
		395	Enables logging for the given levels, leaving all others unchanged.
		396
		397	=item $ctx->disable ($level[, $level...])
		398
		399	Disables logging for the given levels, leaving all others unchanged.
		400
		401	=cut
		402
		403	sub _lvl_lst {
		404	map { $_ > 0 && $_ <= 9 ? $_+0 : $STR2LEVEL{$_} \|\| Carp::croak "$_: not a valid logging level, caught" }
		405	@_
		406	}
		407
		408	our $NOP_CB = sub { 0 };
		409
		410	sub levels {
		411	my $ctx = shift;
		412	$ctx->[1] = 0;
		413	$ctx->[1] \|= 1 << $_
		414	for &_lvl_lst;
		415	AnyEvent::Log::_reassess;
		416	}
		417
		418	sub level {
		419	my $ctx = shift;
		420	my $lvl = $_[0] =~ /^(?:0\|off\|none)$/ ? 0 : (_lvl_lst $_[0])[0];
		421	$ctx->[1] = ((1 << $lvl) - 1) << 1;
		422	AnyEvent::Log::_reassess;
		423	}
		424
		425	sub enable {
		426	my $ctx = shift;
		427	$ctx->[1] \|= 1 << $_
		428	for &_lvl_lst;
		429	AnyEvent::Log::_reassess;
		430	}
		431
		432	sub disable {
		433	my $ctx = shift;
		434	$ctx->[1] &= ~(1 << $_)
		435	for &_lvl_lst;
		436	AnyEvent::Log::_reassess;
		437	}
		438
		439	=item $ctx->attach ($ctx2[, $ctx3...])
		440
		441	Attaches the given contexts as parents to this context. It is not an error
		442	to add a context twice (the second add will be ignored).
		443
		444	A context can be specified either as package name or as a context object.
		445
		446	=item $ctx->detach ($ctx2[, $ctx3...])
		447
		448	Removes the given parents from this context - it's not an error to attempt
		449	to remove a context that hasn't been added.
		450
		451	A context can be specified either as package name or as a context object.
		452
		453	=cut
		454
		455	sub attach {
		456	my $ctx = shift;
		457
		458	$ctx->[2]{$_+0} = $_
		459	for map { AnyEvent::Log::ctx $_ } @_;
		460	}
		461
		462	sub detach {
		463	my $ctx = shift;
		464
		465	delete $ctx->[2]{$_+0}
		466	for map { AnyEvent::Log::ctx $_ } @_;
		467	}
		468
		469	=item $ctx->log_cb ($cb->($str))
		470
		471	Replaces the logging callback on the context (C<undef> disables the
		472	logging callback).
		473
		474	The logging callback is responsible for handling formatted log messages
		475	(see C<fmt_cb> below) - normally simple text strings that end with a
		476	newline (and are possibly multiline themselves).
		477
		478	It also has to return true iff it has consumed the log message, and false
		479	if it hasn't. Consuming a message means that it will not be sent to any
		480	parent context. When in doubt, return C<0> from your logging callback.
		481
		482	Example: a very simple logging callback, simply dump the message to STDOUT
		483	and do not consume it.
		484
		485	$ctx->log_cb (sub { print STDERR shift; 0 });
		486
		487	=item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message))
		488
		489	Replaces the fornatting callback on the cobntext (C<undef> restores the
		490	default formatter).
		491
		492	The callback is passed the (possibly fractional) timestamp, the original
		493	logging context, the (numeric) logging level and the raw message string and needs to
		494	return a formatted log message. In most cases this will be a string, but
		495	it could just as well be an array reference that just stores the values.
		496
		497	Example: format just the raw message, with numeric log level in angle
		498	brackets.
		499
		500	$ctx->fmt_cb (sub {
		501	my ($time, $ctx, $lvl, $msg) = @_;
		502
		503	"<$lvl>$msg\n"
		504	});
		505
		506	Example: return an array reference with just the log values, and use
		507	C<PApp::SQL::sql_exec> to store the emssage in a database.
		508
		509	$ctx->fmt_cb (sub { \@_ });
		510	$ctx->log_cb (sub {
		511	my ($msg) = @_;
		512
		513	sql_exec "insert into log (when, subsys, prio, msg) values (?, ?, ?, ?)",
		514	$msg->[0] + 0,
		515	"$msg->[1]",
		516	$msg->[2] + 0,
		517	"$msg->[3]";
		518
		519	0
		520	});
		521
		522	=cut
		523
		524	sub log_cb {
		525	my ($ctx, $cb) = @_;
		526
		527	$ctx->[3] = $cb \|\| $default_log_cb;
		528	}
		529
		530	sub fmt_cb {
		531	my ($ctx, $cb) = @_;
		532
		533	$ctx->[4] = $cb;
		534	}
		535
		536	=item $ctx->log ($level, $msg[, @params])
		537
		538	Same as C<AnyEvent::Log::log>, but uses the given context as log context.
		539
		540	=item $logger = $ctx->logger ($level[, \$enabled])
		541
		542	Same as C<AnyEvent::Log::logger>, but uses the given context as log
		543	context.
		544
		545	=cut
		546
		547	*log = \&AnyEvent::Log::_log;
		548	*logger = \&AnyEvent::Log::_logger;
252		549
253	1;	550	1;
254		551
255	=back	552	=back
256		553

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.8 by root, Fri Aug 19 19:20:36 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.8 by root, Fri Aug 19 19:20:36 2011 UTC