lib/AnyEvent/Log.pm

=head1 NAME

AnyEvent::Log - simple logging "framework"

=head1 SYNOPSIS

   use AnyEvent::Log;

=head1 DESCRIPTION

This module implements a relatively simple "logging framework". It doesn't
attempt to be "the" logging solution or even "a" logging solution for
AnyEvent - AnyEvent simply creates logging messages internally, and this
module more or less exposes the mechanism, with some extra spiff to allow
using it from other modules as well.

Remember that the default verbosity level is C<0>, so nothing will be
logged, ever, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
before starting your program.#TODO

Possible future extensions are to allow custom log targets (where the
level is an object), log filtering based on package, formatting, aliasing
or package groups.

=head1 LOG FUNCTIONS

These functions allow you to log messages. They always use the caller's
package as a "logging module/source". Also, The main logging function is
easily available as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent>
module is loaded.

=over 4

=cut

package AnyEvent::Log;

use Carp ();
use POSIX ();

use AnyEvent (); BEGIN { AnyEvent::common_sense }
use AnyEvent::Util ();

our ($now_int, $now_str1, $now_str2);

# Format Time, not public - yet?
sub ft($) {
   my $i = int $_[0];
   my $f = sprintf "%06d", 1e6 * ($_[0] - $i);

   ($now_int, $now_str1, $now_str2) = ($i, split /\x01/, POSIX::strftime "%Y-%m-%d %H:%M:%S.\x01 %z", localtime $i)
      if $now_int != $i;

   "$now_str1$f$now_str2"
}

our %CTX; # all logging contexts

=item AnyEvent::Log::log $level, $msg[, @args]

Requests logging of the given C<$msg> with the given log level (1..9).
You can also use the following strings as log level: C<fatal> (1),
C<alert> (2), C<critical> (3), C<error> (4), C<warn> (5), C<note> (6),
C<info> (7), C<debug> (8), C<trace> (9).

For C<fatal> log levels, the program will abort.

If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the
C<$msg> is interpreted as an sprintf format string.

The C<$msg> should not end with C<\n>, but may if that is convenient for
you. Also, multiline messages are handled properly.

Last not least, C<$msg> might be a code reference, in which case it is
supposed to return the message. It will be called only then the message
actually gets logged, which is useful if it is costly to create the
message in the first place.

Whether the given message will be logged depends on the maximum log level
and the caller's package.

Note that you can (and should) call this function as C<AnyEvent::log> or
C<AE::log>, without C<use>-ing this module if possible, as those functions
will laod the logging module on demand only.

Example: log something at error level.

   AE::log error => "something";

Example: use printf-formatting.

   AE::log info => "%5d %-10.10s %s", $index, $category, $msg;

Example: only generate a costly dump when the message is actually being logged.

   AE::log debug => sub { require Data::Dump; Data::Dump::dump \%cache };

=cut

# also allow syslog equivalent names
our %STR2LEVEL = (
   fatal    => 1, emerg    => 1,
   alert    => 2,
   critical => 3, crit     => 3,
   error    => 4, err      => 4,
   warn     => 5, warning  => 5,
   note     => 6, notice   => 6,
   info     => 7,
   debug    => 8,
   trace    => 9,
);

sub now () { time }
AnyEvent::post_detect {
   *now = \&AE::now;
};

our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);

sub _log {
   my ($pkg, $targ, $msg, @args) = @_;

   my $level = ref $targ ? die "Can't use reference as logging level (yet)"
             : $targ > 0 && $targ <= 9 ? $targ+0
             : $STR2LEVEL{$targ} || Carp::croak "$targ: not a valid logging level, caught";

   #TODO: find actual targets, see if we even have to log

   return unless $level <= $AnyEvent::VERBOSE;

   $msg = $msg->() if ref $msg;
   $msg = sprintf $msg, @args if @args;
   $msg =~ s/\n$//;

   # now we have a message, log it

   # TODO: writers/processors/filters/formatters?

   $msg = sprintf "%-5s %s: %s", $LEVEL2STR[$level], $pkg, $msg;
   my $pfx = ft now;

   for (split /\n/, $msg) {
      printf STDERR "$pfx $_\n";
      $pfx = "\t";
   }

   exit 1 if $level <= 1;
}

sub log($$;@) {
   _log +(caller)[0], @_;
}

*AnyEvent::log = *AE::log = \&log;

=item $logger = AnyEvent::Log::logger $level[, \$enabled]

Creates a code reference that, when called, acts as if the
C<AnyEvent::Log::log> function was called at this point with the givne
level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
the C<AnyEvent::Log::log> function:

   my $debug_log = AnyEvent::Log::logger "debug";

   $debug_log->("debug here");
   $debug_log->("%06d emails processed", 12345);
   $debug_log->(sub { $obj->as_string });

The idea behind this function is to decide whether to log before actually
logging - when the C<logger> function is called once, but the returned
logger callback often, then this can be a tremendous speed win.

Despite this speed advantage, changes in logging configuration will
still be reflected by the logger callback, even if configuration changes
I<after> it was created.

To further speed up logging, you can bind a scalar variable to the logger,
which contains true if the logger should be called or not - if it is
false, calling the logger can be safely skipped. This variable will be
updated as long as C<$logger> is alive.

Full example:

   # near the init section
   use AnyEvent::Log;

   my $debug_log = AnyEvent:Log::logger debug => \my $debug;

   # and later in your program
   $debug_log->("yo, stuff here") if $debug;

   $debug and $debug_log->("123");

Note: currently the enabled var is always true - that will be fixed in a
future version :)

=cut

our %LOGGER;

# re-assess logging status for all loggers
sub _reassess {
   for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
      my ($pkg, $level, $renabled) = @$_;

      # to detetc whether a message would be logged, we # actually
      # try to log one and die. this isn't # fast, but we can be
      # sure that the logging decision is correct :)

      $$renabled = !eval {
         local $SIG{__DIE__};

         _log $pkg, $level, sub { die };

         1
      };

      $$renabled = 1; # TODO
   }
}

sub logger($;$) {
   my ($level, $renabled) = @_;

   $renabled ||= \my $enabled;
   my $pkg = (caller)[0];

   $$renabled = 1;

   my $logger = [$pkg, $level, $renabled];

   $LOGGER{$logger+0} = $logger;

   _reassess $logger+0;

   my $guard = AnyEvent::Util::guard {
      # "clean up"
      delete $LOGGER{$logger+0};
   };

   sub {
      $guard if 0; # keep guard alive, but don't cause runtime overhead

      _log $pkg, $level, @_
         if $$renabled;
   }
}

#TODO

=back

=head1 CONFIGURATION FUNCTIONALITY

None, yet, except for C<PERL_ANYEVENT_VERBOSE>, described in the L<AnyEvent> manpage.
#TODO

=over 4

=item $ctx = AnyEvent::Log::cfg [$pkg]

Returns a I<config> object for the given package name (or previously
created package-less configuration). If no package name, or C<undef>, is
given, then it creates a new anonymous context that is not tied to any
package.

=cut

sub cfg(;$) {
   my $name = shift;

   my $ctx = defined $name ? $CTX{$name} : undef;

   unless ($ctx) {
      $ctx = bless {}, "AnyEvent::Log::Ctx";
      $name = -$ctx unless defined $name;
      $ctx->{name} = $name;
      $CTX{$name} = $ctx;
   }

   $ctx
}

package AnyEvent::Log::Ctx;

sub DESTROY {
   # if only one member is remaining (name!) then delete this context
   delete $CTX{$_[0]{name}}
      if 1 == scalar keys %{ $_[0] };
}

1;

=back

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut
Revision:	1.6
Committed:	Wed Aug 17 22:34:11 2011 UTC (12 years, 9 months ago) by root
Branch:	MAIN
Changes since 1.5:	+21 -14 lines
Log Message:	* empty log message *
#	Content
1	=head1 NAME
2
3	AnyEvent::Log - simple logging "framework"
4
5	=head1 SYNOPSIS
6
7	use AnyEvent::Log;
8
9	=head1 DESCRIPTION
10
11	This module implements a relatively simple "logging framework". It doesn't
12	attempt to be "the" logging solution or even "a" logging solution for
13	AnyEvent - AnyEvent simply creates logging messages internally, and this
14	module more or less exposes the mechanism, with some extra spiff to allow
15	using it from other modules as well.
16
17	Remember that the default verbosity level is C<0>, so nothing will be
18	logged, ever, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
19	before starting your program.#TODO
20
21	Possible future extensions are to allow custom log targets (where the
22	level is an object), log filtering based on package, formatting, aliasing
23	or package groups.
24
25	=head1 LOG FUNCTIONS
26
27	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
29	easily available as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent>
30	module is loaded.
31
32	=over 4
33
34	=cut
35
36	package AnyEvent::Log;
37
38	use Carp ();
39	use POSIX ();
40
41	use AnyEvent (); BEGIN { AnyEvent::common_sense }
42	use AnyEvent::Util ();
43
44	our ($now_int, $now_str1, $now_str2);
45
46	# Format Time, not public - yet?
47	sub ft($) {
48	my $i = int $_[0];
49	my $f = sprintf "%06d", 1e6 * ($_[0] - $i);
50
51	($now_int, $now_str1, $now_str2) = ($i, split /\x01/, POSIX::strftime "%Y-%m-%d %H:%M:%S.\x01 %z", localtime $i)
52	if $now_int != $i;
53
54	"$now_str1$f$now_str2"
55	}
56
57	our %CTX; # all logging contexts
58
59	=item AnyEvent::Log::log $level, $msg[, @args]
60
61	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),
63	C<alert> (2), C<critical> (3), C<error> (4), C<warn> (5), C<note> (6),
64	C<info> (7), C<debug> (8), C<trace> (9).
65
66	For C<fatal> log levels, the program will abort.
67
68	If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the
69	C<$msg> is interpreted as an sprintf format string.
70
71	The C<$msg> should not end with C<\n>, but may if that is convenient for
72	you. Also, multiline messages are handled properly.
73
74	Last not least, C<$msg> might be a code reference, in which case it is
75	supposed to return the message. It will be called only then the message
76	actually gets logged, which is useful if it is costly to create the
77	message in the first place.
78
79	Whether the given message will be logged depends on the maximum log level
80	and the caller's package.
81
82	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
84	will laod the logging module on demand only.
85
86	Example: log something at error level.
87
88	AE::log error => "something";
89
90	Example: use printf-formatting.
91
92	AE::log info => "%5d %-10.10s %s", $index, $category, $msg;
93
94	Example: only generate a costly dump when the message is actually being logged.
95
96	AE::log debug => sub { require Data::Dump; Data::Dump::dump \%cache };
97
98	=cut
99
100	# also allow syslog equivalent names
101	our %STR2LEVEL = (
102	fatal => 1, emerg => 1,
103	alert => 2,
104	critical => 3, crit => 3,
105	error => 4, err => 4,
106	warn => 5, warning => 5,
107	note => 6, notice => 6,
108	info => 7,
109	debug => 8,
110	trace => 9,
111	);
112
113	sub now () { time }
114	AnyEvent::post_detect {
115	*now = \&AE::now;
116	};
117
118	our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
119
120	sub _log {
121	my ($pkg, $targ, $msg, @args) = @_;
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;
141
142	for (split /\n/, $msg) {
143	printf STDERR "$pfx $_\n";
144	$pfx = "\t";
145	}
146
147	exit 1 if $level <= 1;
148	}
149
150	sub log($$;@) {
151	_log +(caller)[0], @_;
152	}
153
154	AnyEvent::log = AE::log = \&log;
155
156	=item $logger = AnyEvent::Log::logger $level[, \$enabled]
157
158	Creates a code reference that, when called, acts as if the
159	C<AnyEvent::Log::log> function was called at this point with the givne
160	level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
161	the C<AnyEvent::Log::log> function:
162
163	my $debug_log = AnyEvent::Log::logger "debug";
164
165	$debug_log->("debug here");
166	$debug_log->("%06d emails processed", 12345);
167	$debug_log->(sub { $obj->as_string });
168
169	The idea behind this function is to decide whether to log before actually
170	logging - when the C<logger> function is called once, but the returned
171	logger callback often, then this can be a tremendous speed win.
172
173	Despite this speed advantage, changes in logging configuration will
174	still be reflected by the logger callback, even if configuration changes
175	I<after> it was created.
176
177	To further speed up logging, you can bind a scalar variable to the logger,
178	which contains true if the logger should be called or not - if it is
179	false, calling the logger can be safely skipped. This variable will be
180	updated as long as C<$logger> is alive.
181
182	Full example:
183
184	# near the init section
185	use AnyEvent::Log;
186
187	my $debug_log = AnyEvent:Log::logger debug => \my $debug;
188
189	# and later in your program
190	$debug_log->("yo, stuff here") if $debug;
191
192	$debug and $debug_log->("123");
193
194	Note: currently the enabled var is always true - that will be fixed in a
195	future version :)
196
197	=cut
198
199	our %LOGGER;
200
201	# re-assess logging status for all loggers
202	sub _reassess {
203	for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
204	my ($pkg, $level, $renabled) = @$_;
205
206	# 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
208	# sure that the logging decision is correct :)
209
210	$$renabled = !eval {
211	local $SIG{__DIE__};
212
213	_log $pkg, $level, sub { die };
214
215	1
216	};
217
218	$$renabled = 1; # TODO
219	}
220	}
221
222	sub logger($;$) {
223	my ($level, $renabled) = @_;
224
225	$renabled \|\|= \my $enabled;
226	my $pkg = (caller)[0];
227
228	$$renabled = 1;
229
230	my $logger = [$pkg, $level, $renabled];
231
232	$LOGGER{$logger+0} = $logger;
233
234	_reassess $logger+0;
235
236	my $guard = AnyEvent::Util::guard {
237	# "clean up"
238	delete $LOGGER{$logger+0};
239	};
240
241	sub {
242	$guard if 0; # keep guard alive, but don't cause runtime overhead
243
244	_log $pkg, $level, @_
245	if $$renabled;
246	}
247	}
248
249	#TODO
250
251	=back
252
253	=head1 CONFIGURATION FUNCTIONALITY
254
255	None, yet, except for C<PERL_ANYEVENT_VERBOSE>, described in the L<AnyEvent> manpage.
256	#TODO
257
258	=over 4
259
260	=item $ctx = AnyEvent::Log::cfg [$pkg]
261
262	Returns a I<config> object for the given package name (or previously
263	created package-less configuration). If no package name, or C<undef>, is
264	given, then it creates a new anonymous context that is not tied to any
265	package.
266
267	=cut
268
269	sub cfg(;$) {
270	my $name = shift;
271
272	my $ctx = defined $name ? $CTX{$name} : undef;
273
274	unless ($ctx) {
275	$ctx = bless {}, "AnyEvent::Log::Ctx";
276	$name = -$ctx unless defined $name;
277	$ctx->{name} = $name;
278	$CTX{$name} = $ctx;
279	}
280
281	$ctx
282	}
283
284	package AnyEvent::Log::Ctx;
285
286	sub DESTROY {
287	# if only one member is remaining (name!) then delete this context
288	delete $CTX{$_[0]{name}}
289	if 1 == scalar keys %{ $_[0] };
290	}
291
292	1;
293
294	=back
295
296	=head1 AUTHOR
297
298	Marc Lehmann <schmorp@schmorp.de>
299	http://home.schmorp.de/
300
301	=cut