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<$Anyvent::VERBOSE> or
C<PERL_ANYEVENT_VERBOSE> to a higher number.

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 %CFG; #TODO

=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,
);

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";

   return if $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: could do LOTS of stuff here, and should, at least in some later version

   $msg = sprintf "%5s %s: %s", $LEVEL2STR[$level], $pkg, $msg;
   my $pfx = ft AE::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.

=over 4

=cut

1;

=back

=head1 AUTHOR

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

=cut
Revision:	1.3
Committed:	Wed Aug 17 02:02:38 2011 UTC (12 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.2:	+120 -7 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			Remember that the default verbosity level is C<0>, so nothing
18			will be logged, ever, unless you set C<$Anyvent::VERBOSE> or
19			C<PERL_ANYEVENT_VERBOSE> to a higher number.
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	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.3	our %CFG; #TODO
58
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			our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
114
115	root	1.3	sub _log {
116			my ($pkg, $targ, $msg, @args) = @_;
117	root	1.2
118			my $level = ref $targ ? die "Can't use reference as logging level (yet)"
119			: $targ > 0 && $targ <= 9 ? $targ+0
120			: $STR2LEVEL{$targ} \|\| Carp::croak "$targ: not a valid logging level, caught";
121
122			return if $level > $AnyEvent::VERBOSE;
123
124	root	1.3	$msg = $msg->() if ref $msg;
125	root	1.2	$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	root	1.3	$msg = sprintf "%5s %s: %s", $LEVEL2STR[$level], $pkg, $msg;
132	root	1.2	my $pfx = ft AE::now;
133
134			for (split /\n/, $msg) {
135			printf STDERR "$pfx $_\n";
136			$pfx = "\t";
137			}
138
139			exit 1 if $level <= 1;
140			}
141
142	root	1.3	sub log($$;@) {
143			_log +(caller)[0], @_;
144			}
145
146	root	1.2	AnyEvent::log = AE::log = \&log;
147
148	root	1.3	=item $logger = AnyEvent::Log::logger $level[, \$enabled]
149
150			Creates a code reference that, when called, acts as if the
151			C<AnyEvent::Log::log> function was called at this point with the givne
152			level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
153			the C<AnyEvent::Log::log> function:
154
155			my $debug_log = AnyEvent::Log::logger "debug";
156
157			$debug_log->("debug here");
158			$debug_log->("%06d emails processed", 12345);
159			$debug_log->(sub { $obj->as_string });
160
161			The idea behind this function is to decide whether to log before actually
162			logging - when the C<logger> function is called once, but the returned
163			logger callback often, then this can be a tremendous speed win.
164
165			Despite this speed advantage, changes in logging configuration will
166			still be reflected by the logger callback, even if configuration changes
167			I<after> it was created.
168
169			To further speed up logging, you can bind a scalar variable to the logger,
170			which contains true if the logger should be called or not - if it is
171			false, calling the logger can be safely skipped. This variable will be
172			updated as long as C<$logger> is alive.
173
174			Full example:
175
176			# near the init section
177			use AnyEvent::Log;
178
179			my $debug_log = AnyEvent:Log::logger debug => \my $debug;
180
181			# and later in your program
182			$debug_log->("yo, stuff here") if $debug;
183
184			$debug and $debug_log->("123");
185
186			Note: currently the enabled var is always true - that will be fixed in a
187			future version :)
188
189			=cut
190
191			our %LOGGER;
192
193			# re-assess logging status for all loggers
194			sub _reassess {
195			for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
196			my ($pkg, $level, $renabled) = @$_;
197
198			# 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
200			# sure that the logging decision is correct :)
201
202			$$renabled = !eval {
203			local $SIG{__DIE__};
204
205			_log $pkg, $level, sub { die };
206
207			1
208			};
209
210			$$renabled = 1; # TODO
211			}
212			}
213
214			sub logger($;$) {
215			my ($level, $renabled) = @_;
216
217			$renabled \|\|= \my $enabled;
218			my $pkg = (caller)[0];
219
220			$$renabled = 1;
221
222			my $logger = [$pkg, $level, $renabled];
223
224			$LOGGER{$logger+0} = $logger;
225
226			_reassess $logger+0;
227
228			my $guard = AnyEvent::Util::guard {
229			# "clean up"
230			delete $LOGGER{$logger+0};
231			};
232
233			sub {
234			$guard if 0; # keep guard alive, but don't cause runtime overhead
235
236			_log $pkg, $level, @_
237			if $$renabled;
238			}
239			}
240
241	root	1.2	#TODO
242
243			=back
244
245			=head1 CONFIGURATION FUNCTIONALITY
246
247			None, yet, except for C<PERL_ANYEVENT_VERBOSE>, described in the L<AnyEvent> manpage.
248
249			=over 4
250
251			=cut
252
253	root	1.1	1;
254
255			=back
256
257			=head1 AUTHOR
258
259			Marc Lehmann <schmorp@schmorp.de>
260			http://home.schmorp.de/
261
262			=cut