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, 10 months ago) by root
Branch:	MAIN
Changes since 1.5:	+21 -14 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.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	root	1.2	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	root	1.5	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	root	1.2
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	root	1.1
32			=over 4
33
34			=cut
35
36			package AnyEvent::Log;
37
38	root	1.2	use Carp ();
39	root	1.1	use POSIX ();
40
41			use AnyEvent (); BEGIN { AnyEvent::common_sense }
42	root	1.3	use AnyEvent::Util ();
43	root	1.1
44	root	1.2	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	root	1.5	our %CTX; # all logging contexts
58	root	1.3
59	root	1.2	=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	root	1.3	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	root	1.2
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	root	1.3	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	root	1.2	=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	root	1.4	sub now () { time }
114			AnyEvent::post_detect {
115			*now = \&AE::now;
116			};
117
118	root	1.2	our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
119
120	root	1.3	sub _log {
121			my ($pkg, $targ, $msg, @args) = @_;
122	root	1.2
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	root	1.4	#TODO: find actual targets, see if we even have to log
128
129			return unless $level <= $AnyEvent::VERBOSE;
130	root	1.2
131	root	1.3	$msg = $msg->() if ref $msg;
132	root	1.2	$msg = sprintf $msg, @args if @args;
133			$msg =~ s/\n$//;
134
135			# now we have a message, log it
136
137	root	1.4	# TODO: writers/processors/filters/formatters?
138
139			$msg = sprintf "%-5s %s: %s", $LEVEL2STR[$level], $pkg, $msg;
140			my $pfx = ft now;
141	root	1.2
142			for (split /\n/, $msg) {
143			printf STDERR "$pfx $_\n";
144			$pfx = "\t";
145			}
146
147			exit 1 if $level <= 1;
148			}
149
150	root	1.3	sub log($$;@) {
151			_log +(caller)[0], @_;
152			}
153
154	root	1.2	AnyEvent::log = AE::log = \&log;
155
156	root	1.3	=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	root	1.2	#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	root	1.6	#TODO
257	root	1.2
258			=over 4
259
260	root	1.6	=item $ctx = AnyEvent::Log::cfg [$pkg]
261	root	1.5
262	root	1.6	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	root	1.5
267	root	1.2	=cut
268
269	root	1.6	sub cfg(;$) {
270	root	1.5	my $name = shift;
271
272			my $ctx = defined $name ? $CTX{$name} : undef;
273
274	root	1.6	unless ($ctx) {
275	root	1.5	$ctx = bless {}, "AnyEvent::Log::Ctx";
276	root	1.6	$name = -$ctx unless defined $name;
277			$ctx->{name} = $name;
278			$CTX{$name} = $ctx;
279			}
280
281			$ctx
282			}
283	root	1.5
284	root	1.6	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	root	1.5	}
291
292	root	1.1	1;
293
294			=back
295
296			=head1 AUTHOR
297
298			Marc Lehmann <schmorp@schmorp.de>
299			http://home.schmorp.de/
300
301			=cut