ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent/Log.pm
(Generate patch)

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents):
Revision 1.1 by root, Mon Aug 15 23:21:09 2011 UTC vs.
Revision 1.8 by root, Fri Aug 19 19:20:36 2011 UTC

2 2
3AnyEvent::Log - simple logging "framework" 3AnyEvent::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;
8 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]...
25
9=head1 DESCRIPTION 26=head1 DESCRIPTION
10 27
28This module implements a relatively simple "logging framework". It doesn't
29attempt to be "the" logging solution or even "a" logging solution for
30AnyEvent - AnyEvent simply creates logging messages internally, and this
31module more or less exposes the mechanism, with some extra spiff to allow
32using it from other modules as well.
33
34Remember that the default verbosity level is C<0>, so nothing will be
35logged, ever, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
36before starting your program.#TODO
37
38Possible future extensions are to allow custom log targets (where the
39level is an object), log filtering based on package, formatting, aliasing
40or package groups.
41
11=head1 FUNCTIONS 42=head1 LOG FUNCTIONS
43
44These functions allow you to log messages. They always use the caller's
45package as a "logging module/source". Also, the main logging function is
46callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is
47loaded.
12 48
13=over 4 49=over 4
14 50
15=cut 51=cut
16 52
17package AnyEvent::Log; 53package AnyEvent::Log;
18 54
55use Carp ();
19use POSIX (); 56use POSIX ();
20 57
21use AnyEvent (); BEGIN { AnyEvent::common_sense } 58use AnyEvent (); BEGIN { AnyEvent::common_sense }
59use AnyEvent::Util ();
60
61our ($now_int, $now_str1, $now_str2);
62
63# Format Time, not public - yet?
64sub ft($) {
65 my $i = int $_[0];
66 my $f = sprintf "%06d", 1e6 * ($_[0] - $i);
67
68 ($now_int, $now_str1, $now_str2) = ($i, split /\x01/, POSIX::strftime "%Y-%m-%d %H:%M:%S.\x01 %z", localtime $i)
69 if $now_int != $i;
70
71 "$now_str1$f$now_str2"
72}
73
74our %CTX; # all logging contexts
75
76my $default_log_cb = sub { 0 };
77
78# creates a default package context object for the given package
79sub _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}
90
91=item AnyEvent::Log::log $level, $msg[, @args]
92
93Requests logging of the given C<$msg> with the given log level (1..9).
94You can also use the following strings as log level: C<fatal> (1),
95C<alert> (2), C<critical> (3), C<error> (4), C<warn> (5), C<note> (6),
96C<info> (7), C<debug> (8), C<trace> (9).
97
98For C<fatal> log levels, the program will abort.
99
100If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the
101C<$msg> is interpreted as an sprintf format string.
102
103The C<$msg> should not end with C<\n>, but may if that is convenient for
104you. Also, multiline messages are handled properly.
105
106Last not least, C<$msg> might be a code reference, in which case it is
107supposed to return the message. It will be called only then the message
108actually gets logged, which is useful if it is costly to create the
109message in the first place.
110
111Whether the given message will be logged depends on the maximum log level
112and the caller's package.
113
114Note that you can (and should) call this function as C<AnyEvent::log> or
115C<AE::log>, without C<use>-ing this module if possible (i.e. you don't
116need any additional functionality), as those functions will load the
117logging module on demand only. They are also much shorter to write.
118
119Also, if you otpionally generate a lot of debug messages (such as when
120tracing some code), you should look into using a logger callback and a
121boolean enabler (see C<logger>, below).
122
123Example: log something at error level.
124
125 AE::log error => "something";
126
127Example: use printf-formatting.
128
129 AE::log info => "%5d %-10.10s %s", $index, $category, $msg;
130
131Example: only generate a costly dump when the message is actually being logged.
132
133 AE::log debug => sub { require Data::Dump; Data::Dump::dump \%cache };
134
135=cut
136
137# also allow syslog equivalent names
138our %STR2LEVEL = (
139 fatal => 1, emerg => 1,
140 alert => 2,
141 critical => 3, crit => 3,
142 error => 4, err => 4,
143 warn => 5, warning => 5,
144 note => 6, notice => 6,
145 info => 7,
146 debug => 8,
147 trace => 9,
148);
149
150sub now () { time }
151AnyEvent::post_detect {
152 *now = \&AE::now;
153};
154
155our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
156
157# time, ctx, level, msg
158sub _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
167sub _log {
168 my ($ctx, $level, $format, @args) = @_;
169
170 $level = $level > 0 && $level <= 9 ? $level+0 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
171
172 my $mask = 1 << $level;
173 my $now = AE::now;
174
175 my (@ctx, $did_format, $fmt);
176
177 do {
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;
201
202 exit 1 if $level <= 1;
203}
204
205sub log($$;@) {
206 _log
207 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
208 @_;
209}
210
211*AnyEvent::log = *AE::log = \&log;
212
213=item $logger = AnyEvent::Log::logger $level[, \$enabled]
214
215Creates a code reference that, when called, acts as if the
216C<AnyEvent::Log::log> function was called at this point with the givne
217level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
218the C<AnyEvent::Log::log> function:
219
220 my $debug_log = AnyEvent::Log::logger "debug";
221
222 $debug_log->("debug here");
223 $debug_log->("%06d emails processed", 12345);
224 $debug_log->(sub { $obj->as_string });
225
226The idea behind this function is to decide whether to log before actually
227logging - when the C<logger> function is called once, but the returned
228logger callback often, then this can be a tremendous speed win.
229
230Despite this speed advantage, changes in logging configuration will
231still be reflected by the logger callback, even if configuration changes
232I<after> it was created.
233
234To further speed up logging, you can bind a scalar variable to the logger,
235which contains true if the logger should be called or not - if it is
236false, calling the logger can be safely skipped. This variable will be
237updated as long as C<$logger> is alive.
238
239Full example:
240
241 # near the init section
242 use AnyEvent::Log;
243
244 my $debug_log = AnyEvent:Log::logger debug => \my $debug;
245
246 # and later in your program
247 $debug_log->("yo, stuff here") if $debug;
248
249 $debug and $debug_log->("123");
250
251Note: currently the enabled var is always true - that will be fixed in a
252future version :)
253
254=cut
255
256our %LOGGER;
257
258# re-assess logging status for all loggers
259sub _reassess {
260 for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
261 my ($ctx, $level, $renabled) = @$_;
262
263 # to detetc whether a message would be logged, we # actually
264 # try to log one and die. this isn't # fast, but we can be
265 # sure that the logging decision is correct :)
266
267 $$renabled = !eval {
268 local $SIG{__DIE__};
269
270 _log $ctx, $level, sub { die };
271
272 1
273 };
274
275 $$renabled = 1; # TODO
276 }
277}
278
279sub _logger($;$) {
280 my ($ctx, $level, $renabled) = @_;
281
282 $renabled ||= \my $enabled;
283
284 $$renabled = 1;
285
286 my $logger = [$ctx, $level, $renabled];
287
288 $LOGGER{$logger+0} = $logger;
289
290 _reassess $logger+0;
291
292 my $guard = AnyEvent::Util::guard {
293 # "clean up"
294 delete $LOGGER{$logger+0};
295 };
296
297 sub {
298 $guard if 0; # keep guard alive, but don't cause runtime overhead
299
300 _log $ctx, $level, @_
301 if $$renabled;
302 }
303}
304
305sub logger($;$) {
306 _logger
307 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
308 @_
309}
310
311#TODO
312
313=back
314
315=head1 CONFIGURATION FUNCTIONALITY
316
317None, yet, except for C<PERL_ANYEVENT_VERBOSE>, described in the L<AnyEvent> manpage.
318
319#TODO: wahst a context
320#TODO
321
322=over 4
323
324=item $ctx = AnyEvent::Log::ctx [$pkg]
325
326Returns a I<config> object for the given package name.
327
328If no package name is given, returns the context for the current perl
329package (i.e. the same context as a C<AE::log> call would use).
330
331If C<undef> is given, then it creates a new anonymous context that is not
332tied to any package and is destroyed when no longer referenced.
333
334=cut
335
336sub 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
359package AnyEvent::Log::Ctx;
360
361# 0 1 2 3 4
362# [$title, $level, %$parents, &$logcb, &$fmtcb]
363
364=item $ctx->title ([$new_title])
365
366Returns the title of the logging context - this is the package name, for
367package contexts, and a user defined string for all others.
368
369If C<$new_title> is given, then it replaces the package name or title.
370
371=cut
372
373sub title {
374 $_[0][0] = $_[1] if @_ > 1;
375 $_[0][0]
376}
377
378=item $ctx->levels ($level[, $level...)
379
380Enables logging fot the given levels and disables it for all others.
381
382=item $ctx->level ($level)
383
384Enables logging for the given level and all lower level (higher priority)
385ones. Specifying a level of C<0> or C<off> disables all logging for this
386level.
387
388Example: 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
395Enables logging for the given levels, leaving all others unchanged.
396
397=item $ctx->disable ($level[, $level...])
398
399Disables logging for the given levels, leaving all others unchanged.
400
401=cut
402
403sub _lvl_lst {
404 map { $_ > 0 && $_ <= 9 ? $_+0 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" }
405 @_
406}
407
408our $NOP_CB = sub { 0 };
409
410sub levels {
411 my $ctx = shift;
412 $ctx->[1] = 0;
413 $ctx->[1] |= 1 << $_
414 for &_lvl_lst;
415 AnyEvent::Log::_reassess;
416}
417
418sub 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
425sub enable {
426 my $ctx = shift;
427 $ctx->[1] |= 1 << $_
428 for &_lvl_lst;
429 AnyEvent::Log::_reassess;
430}
431
432sub 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
441Attaches the given contexts as parents to this context. It is not an error
442to add a context twice (the second add will be ignored).
443
444A context can be specified either as package name or as a context object.
445
446=item $ctx->detach ($ctx2[, $ctx3...])
447
448Removes the given parents from this context - it's not an error to attempt
449to remove a context that hasn't been added.
450
451A context can be specified either as package name or as a context object.
452
453=cut
454
455sub attach {
456 my $ctx = shift;
457
458 $ctx->[2]{$_+0} = $_
459 for map { AnyEvent::Log::ctx $_ } @_;
460}
461
462sub 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
471Replaces the logging callback on the context (C<undef> disables the
472logging callback).
473
474The logging callback is responsible for handling formatted log messages
475(see C<fmt_cb> below) - normally simple text strings that end with a
476newline (and are possibly multiline themselves).
477
478It also has to return true iff it has consumed the log message, and false
479if it hasn't. Consuming a message means that it will not be sent to any
480parent context. When in doubt, return C<0> from your logging callback.
481
482Example: a very simple logging callback, simply dump the message to STDOUT
483and 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
489Replaces the fornatting callback on the cobntext (C<undef> restores the
490default formatter).
491
492The callback is passed the (possibly fractional) timestamp, the original
493logging context, the (numeric) logging level and the raw message string and needs to
494return a formatted log message. In most cases this will be a string, but
495it could just as well be an array reference that just stores the values.
496
497Example: format just the raw message, with numeric log level in angle
498brackets.
499
500 $ctx->fmt_cb (sub {
501 my ($time, $ctx, $lvl, $msg) = @_;
502
503 "<$lvl>$msg\n"
504 });
505
506Example: return an array reference with just the log values, and use
507C<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
524sub log_cb {
525 my ($ctx, $cb) = @_;
526
527 $ctx->[3] = $cb || $default_log_cb;
528}
529
530sub fmt_cb {
531 my ($ctx, $cb) = @_;
532
533 $ctx->[4] = $cb;
534}
535
536=item $ctx->log ($level, $msg[, @params])
537
538Same as C<AnyEvent::Log::log>, but uses the given context as log context.
539
540=item $logger = $ctx->logger ($level[, \$enabled])
541
542Same as C<AnyEvent::Log::logger>, but uses the given context as log
543context.
544
545=cut
546
547*log = \&AnyEvent::Log::_log;
548*logger = \&AnyEvent::Log::_logger;
22 549
231; 5501;
24 551
25=back 552=back
26 553

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines