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.10 by root, Fri Aug 19 21:17:08 2011 UTC vs.
Revision 1.20 by root, Sat Aug 20 22:27:07 2011 UTC

20 $tracer->("i am here") if $trace; 20 $tracer->("i am here") if $trace;
21 $tracer->(sub { "lots of data: " . Dumper $self }) if $trace; 21 $tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
22 22
23 # configuration 23 # configuration
24 24
25 # set logging for this package to maximum 25 # set logging for the current package to errors and higher only
26 AnyEvent::Log::ctx->level ("all"); 26 AnyEvent::Log::ctx->level ("error");
27 27
28 # set logging globally to anything below debug 28 # set logging globally to anything below debug
29 (AnyEvent::Log::ctx "")->level ("notice"); 29 $AnyEvent::Log::FILTER->level ("notice");
30 30
31 # see also EXAMPLES, below 31 # see also EXAMPLES, below
32
33 # disable logging for package "AnyEvent" and all packages below it
34 AnyEvent->AnyEvent::Log::ctx->level (0);
35
36 # log everything below debug to a file, for the whole program
37 my $ctx = AnyEvent::Log::ctx;
38 $ctx->log_cb (sub { print FILE shift; 0 });
39 (AnyEvent::Log::ctx "")->add ($ctx);
40 32
41=head1 DESCRIPTION 33=head1 DESCRIPTION
42 34
43This module implements a relatively simple "logging framework". It doesn't 35This module implements a relatively simple "logging framework". It doesn't
44attempt to be "the" logging solution or even "a" logging solution for 36attempt to be "the" logging solution or even "a" logging solution for
45AnyEvent - AnyEvent simply creates logging messages internally, and this 37AnyEvent - AnyEvent simply creates logging messages internally, and this
46module more or less exposes the mechanism, with some extra spiff to allow 38module more or less exposes the mechanism, with some extra spiff to allow
47using it from other modules as well. 39using it from other modules as well.
48 40
49Remember that the default verbosity level is C<0>, so nothing will be 41Remember that the default verbosity level is C<0> (C<off>), so nothing
50logged, ever, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number 42will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
51before starting your program, or change the logging level at runtime wiht 43before starting your program, or change the logging level at runtime with
52something like: 44something like:
53 45
54 use AnyEvent; 46 use AnyEvent::Log;
55 (AnyEvent::Log::ctx "")->level ("info"); 47 AnyEvent::Log::FILTER->level ("info");
56 48
57The design goal behind this module was to keep it simple (and small), 49The design goal behind this module was to keep it simple (and small),
58but make it powerful enough to be potentially useful for any module, and 50but make it powerful enough to be potentially useful for any module, and
59extensive enough for the most common tasks, such as logging to multiple 51extensive enough for the most common tasks, such as logging to multiple
60targets, or being able to log into a database. 52targets, or being able to log into a database.
61 53
54The amount of documentation might indicate otherwise, but the module is
55still just below 300 lines of code.
56
57=head1 LOGGING LEVELS
58
59Logging levels in this module range from C<1> (highest priority) to C<9>
60(lowest priority). Note that the lowest numerical value is the highest
61priority, so when this document says "higher priority" it means "lower
62numerical value".
63
64Instead of specifying levels by name you can also specify them by aliases:
65
66 LVL NAME SYSLOG PERL NOTE
67 1 fatal emerg exit aborts program!
68 2 alert
69 3 critical crit
70 4 error err die
71 5 warn warning
72 6 note notice
73 7 info
74 8 debug
75 9 trace
76
77As you can see, some logging levels have multiple aliases - the first one
78is the "official" name, the second one the "syslog" name (if it differs)
79and the third one the "perl" name, suggesting that you log C<die> messages
80at C<error> priority.
81
82You can normally only log a single message at highest priority level
83(C<1>, C<fatal>), because logging a fatal message will also quit the
84program - so use it sparingly :)
85
86Some methods also offer some extra levels, such as C<0>, C<off>, C<none>
87or C<all> - these are only valid in the methods they are documented for.
88
62=head1 LOGGING FUNCTIONS 89=head1 LOGGING FUNCTIONS
63 90
64These functions allow you to log messages. They always use the caller's 91These functions allow you to log messages. They always use the caller's
65package as a "logging module/source". Also, the main logging function is 92package as a "logging context". Also, the main logging function C<log> is
66callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is 93callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is
67loaded. 94loaded.
68 95
69=over 4 96=over 4
70 97
75use Carp (); 102use Carp ();
76use POSIX (); 103use POSIX ();
77 104
78use AnyEvent (); BEGIN { AnyEvent::common_sense } 105use AnyEvent (); BEGIN { AnyEvent::common_sense }
79use AnyEvent::Util (); 106use AnyEvent::Util ();
107
108our $VERSION = $AnyEvent::VERSION;
109
110our ($COLLECT, $FILTER, $LOG);
80 111
81our ($now_int, $now_str1, $now_str2); 112our ($now_int, $now_str1, $now_str2);
82 113
83# Format Time, not public - yet? 114# Format Time, not public - yet?
84sub ft($) { 115sub ft($) {
89 if $now_int != $i; 120 if $now_int != $i;
90 121
91 "$now_str1$f$now_str2" 122 "$now_str1$f$now_str2"
92} 123}
93 124
94our %CTX; # all logging contexts 125our %CTX; # all package contexts
95 126
96# creates a default package context object for the given package 127# creates a default package context object for the given package
97sub _pkg_ctx($) { 128sub _pkg_ctx($) {
98 my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx"; 129 my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx";
99 130
100 # link "parent" package 131 # link "parent" package
101 my $pkg = $_[0] =~ /^(.+)::/ ? $1 : ""; 132 my $parent = $_[0] =~ /^(.+)::/
133 ? $CTX{$1} ||= &_pkg_ctx ("$1")
134 : $COLLECT;
102 135
103 $pkg = $CTX{$pkg} ||= &_pkg_ctx ($pkg);
104 $ctx->[2]{$pkg+0} = $pkg; 136 $ctx->[2]{$parent+0} = $parent;
105 137
106 $ctx 138 $ctx
107} 139}
108 140
109=item AnyEvent::Log::log $level, $msg[, @args] 141=item AnyEvent::Log::log $level, $msg[, @args]
110 142
111Requests logging of the given C<$msg> with the given log level (1..9). 143Requests logging of the given C<$msg> with the given log level.
112You can also use the following strings as log level: C<fatal> (1),
113C<alert> (2), C<critical> (3), C<error> (4), C<warn> (5), C<note> (6),
114C<info> (7), C<debug> (8), C<trace> (9).
115 144
116For C<fatal> log levels, the program will abort. 145For C<fatal> log levels, the program will abort.
117 146
118If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the 147If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the
119C<$msg> is interpreted as an sprintf format string. 148C<$msg> is interpreted as an sprintf format string.
132Note that you can (and should) call this function as C<AnyEvent::log> or 161Note that you can (and should) call this function as C<AnyEvent::log> or
133C<AE::log>, without C<use>-ing this module if possible (i.e. you don't 162C<AE::log>, without C<use>-ing this module if possible (i.e. you don't
134need any additional functionality), as those functions will load the 163need any additional functionality), as those functions will load the
135logging module on demand only. They are also much shorter to write. 164logging module on demand only. They are also much shorter to write.
136 165
137Also, if you otpionally generate a lot of debug messages (such as when 166Also, if you optionally generate a lot of debug messages (such as when
138tracing some code), you should look into using a logger callback and a 167tracing some code), you should look into using a logger callback and a
139boolean enabler (see C<logger>, below). 168boolean enabler (see C<logger>, below).
140 169
141Example: log something at error level. 170Example: log something at error level.
142 171
152 181
153=cut 182=cut
154 183
155# also allow syslog equivalent names 184# also allow syslog equivalent names
156our %STR2LEVEL = ( 185our %STR2LEVEL = (
157 fatal => 1, emerg => 1, 186 fatal => 1, emerg => 1, exit => 1,
158 alert => 2, 187 alert => 2,
159 critical => 3, crit => 3, 188 critical => 3, crit => 3,
160 error => 4, err => 4, 189 error => 4, err => 4, die => 4,
161 warn => 5, warning => 5, 190 warn => 5, warning => 5,
162 note => 6, notice => 6, 191 note => 6, notice => 6,
163 info => 7, 192 info => 7,
164 debug => 8, 193 debug => 8,
165 trace => 9, 194 trace => 9,
173 202
174our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace); 203our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
175 204
176# time, ctx, level, msg 205# time, ctx, level, msg
177sub _format($$$$) { 206sub _format($$$$) {
178 my $pfx = ft $_[0]; 207 my $ts = ft $_[0];
208 my $ct = " ";
209
179 my @res; 210 my @res;
180 211
181 for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) { 212 for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) {
182 push @res, "$pfx $_\n"; 213 push @res, "$ts$ct$_\n";
183 $pfx = "\t"; 214 $ct = " + ";
184 } 215 }
185 216
186 join "", @res 217 join "", @res
187} 218}
188 219
189sub _log { 220sub _log {
190 my ($ctx, $level, $format, @args) = @_; 221 my ($ctx, $level, $format, @args) = @_;
191 222
223 $level = $level > 0 && $level <= 9
224 ? $level+0
192 $level = $level > 0 && $level <= 9 ? $level+0 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; 225 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
193 226
194 my $mask = 1 << $level; 227 my $mask = 1 << $level;
195 228
196 my (@ctx, $now, $fmt); 229 my (%seen, @ctx, $now, $fmt);
197 230
198 do { 231 do
232 {
199 # skip if masked 233 # skip if masked
200 next unless $ctx->[1] & $mask; 234 if ($ctx->[1] & $mask && !$seen{$ctx+0}++) {
201
202 if ($ctx->[3]) { 235 if ($ctx->[3]) {
203 # logging target found 236 # logging target found
204 237
205 # now get raw message, unless we have it already 238 # now get raw message, unless we have it already
206 unless ($now) { 239 unless ($now) {
207 $format = $format->() if ref $format; 240 $format = $format->() if ref $format;
208 $format = sprintf $format, @args if @args; 241 $format = sprintf $format, @args if @args;
209 $format =~ s/\n$//; 242 $format =~ s/\n$//;
210 $now = AE::now; 243 $now = AE::now;
244 };
245
246 # format msg
247 my $str = $ctx->[4]
248 ? $ctx->[4]($now, $_[0], $level, $format)
249 : ($fmt ||= _format $now, $_[0], $level, $format);
250
251 $ctx->[3]($str, $_[0], $level)
252 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
253 } else {
254 push @ctx, values %{ $ctx->[2] }; # not masked - propagate
255 }
211 }; 256 }
212
213 # format msg
214 my $str = $ctx->[4]
215 ? $ctx->[4]($now, $_[0], $level, $format)
216 : $fmt ||= _format $now, $_[0], $level, $format;
217
218 $ctx->[3]($str)
219 and next;
220 } 257 }
221
222 # not masked, not consume - propagate to parent contexts
223 push @ctx, values %{ $ctx->[2] };
224 } while $ctx = pop @ctx; 258 while $ctx = pop @ctx;
225 259
226 exit 1 if $level <= 1; 260 exit 1 if $level <= 1;
227} 261}
228 262
229sub log($$;@) { 263sub log($$;@) {
270 # and later in your program 304 # and later in your program
271 $debug_log->("yo, stuff here") if $debug; 305 $debug_log->("yo, stuff here") if $debug;
272 306
273 $debug and $debug_log->("123"); 307 $debug and $debug_log->("123");
274 308
275Note: currently the enabled var is always true - that will be fixed in a
276future version :)
277
278=cut 309=cut
279 310
280our %LOGGER; 311our %LOGGER;
281 312
282# re-assess logging status for all loggers 313# re-assess logging status for all loggers
283sub _reassess { 314sub _reassess {
315 local $SIG{__DIE__};
316 my $die = sub { die };
317
284 for (@_ ? $LOGGER{$_[0]} : values %LOGGER) { 318 for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
285 my ($ctx, $level, $renabled) = @$_; 319 my ($ctx, $level, $renabled) = @$_;
286 320
287 # to detetc whether a message would be logged, we # actually 321 # to detect whether a message would be logged, we actually
288 # try to log one and die. this isn't # fast, but we can be 322 # try to log one and die. this isn't fast, but we can be
289 # sure that the logging decision is correct :) 323 # sure that the logging decision is correct :)
290 324
291 $$renabled = !eval { 325 $$renabled = !eval {
292 local $SIG{__DIE__};
293
294 _log $ctx, $level, sub { die }; 326 _log $ctx, $level, $die;
295 327
296 1 328 1
297 }; 329 };
298
299 $$renabled = 1; # TODO
300 } 330 }
301} 331}
302 332
303sub _logger($;$) { 333sub _logger {
304 my ($ctx, $level, $renabled) = @_; 334 my ($ctx, $level, $renabled) = @_;
305
306 $renabled ||= \my $enabled;
307 335
308 $$renabled = 1; 336 $$renabled = 1;
309 337
310 my $logger = [$ctx, $level, $renabled]; 338 my $logger = [$ctx, $level, $renabled];
311 339
351timestamp, context, level and string message and formats it in the way 379timestamp, context, level and string message and formats it in the way
352it should be logged) and a logging callback (which is responsible for 380it should be logged) and a logging callback (which is responsible for
353actually logging the formatted message and telling C<AnyEvent::Log> 381actually logging the formatted message and telling C<AnyEvent::Log>
354whether it has consumed the message, or whether it should be propagated). 382whether it has consumed the message, or whether it should be propagated).
355 383
356For propagation, a context can have any number of attached I<parent 384For propagation, a context can have any number of attached I<slave
357contexts>. Any message that is neither masked by the logging mask nor 385contexts>. Any message that is neither masked by the logging mask nor
358masked by the logging callback returning true will be passed to all parent 386masked by the logging callback returning true will be passed to all slave
359contexts. 387contexts.
388
389Each call to a logging function will log the message at most once per
390context, so it does not matter (much) if there are cycles or if the
391message can arrive at the same context via multiple paths.
360 392
361=head2 DEFAULTS 393=head2 DEFAULTS
362 394
363By default, all logging contexts have an full set of log levels ("all"), a 395By default, all logging contexts have an full set of log levels ("all"), a
364disabled logging callback and the default formatting callback. 396disabled logging callback and the default formatting callback.
365 397
366Package contexts have the package name as logging title by default. 398Package contexts have the package name as logging title by default.
367 399
368They have exactly one parent - the context of the "parent" package. The 400They have exactly one slave - the context of the "parent" package. The
369parent package is simply defined to be the package name without the last 401parent package is simply defined to be the package name without the last
370component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>, 402component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>,
371and C<AnyEvent> becomes the empty string. 403and C<AnyEvent> becomes ... C<$AnyEvent::Log::COLLECT> which is the
404exception of the rule - just like the "parent" of any single-component
405package name in Perl is C<main>, the default slave of any top-level
406package context is C<$AnyEvent::Log::COLLECT>.
372 407
373Since perl packages form only an approximate hierarchy, this parent 408Since perl packages form only an approximate hierarchy, this slave
374context can of course be removed. 409context can of course be removed.
375 410
376All other (anonymous) contexts have no parents and an empty title by 411All other (anonymous) contexts have no slaves and an empty title by
377default. 412default.
378 413
379When the module is first loaded, it configures the root context (the one 414When the module is loaded it creates the C<$AnyEvent::Log::LOG> logging
380with the empty string) to simply dump all log messages to C<STDERR>, 415context that simply logs everything via C<warn>, without propagating
381and sets it's log level set to all levels up to the one specified by 416anything anywhere by default. The purpose of this context is to provide
382C<$ENV{PERL_ANYEVENT_VERBOSE}>. 417a convenient place to override the global logging target or to attach
418additional log targets. It's not meant for filtering.
419
420It then creates the C<$AnyEvent::Log::FILTER> context whose
421purpose is to suppress all messages with priority higher
422than C<$ENV{PERL_ANYEVENT_VERBOSE}>. It then attached the
423C<$AnyEvent::Log::LOG> context to it. The purpose of the filter context
424is to simply provide filtering according to some global log level.
425
426Finally it creates the top-level package context C<$AnyEvent::Log::COLLECT>
427and attaches the C<$AnyEvent::Log::FILTER> context to it, but otherwise
428leaves it at default config. Its purpose is simply to collect all log
429messages system-wide.
430
431The hierarchy is then:
432
433 any package, eventually -> $COLLECT -> $FILTER -> $LOG
383 434
384The effect of all this is that log messages, by default, wander up to the 435The effect of all this is that log messages, by default, wander up to the
385root context and will be logged to STDERR if their log level is less than 436C<$AnyEvent::Log::COLLECT> context where all messages normally end up,
386or equal to C<$ENV{PERL_ANYEVENT_VERBOSE}>. 437from there to C<$AnyEvent::Log::FILTER> where log messages with lower
438priority then C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered out and then
439to the C<$AnyEvent::Log::LOG> context to be passed to C<warn>.
387 440
441This makes it easy to set a global logging level (by modifying $FILTER),
442but still allow other contexts to send, for example, their debug and trace
443messages to the $LOG target despite the global logging level, or to attach
444additional log targets that log messages, regardless of the global logging
445level.
446
447It also makes it easy to modify the default warn-logger ($LOG) to
448something that logs to a file, or to attach additional logging targets
449(such as loggign to a file) by attaching it to $FILTER.
450
388=head2 CREATING/FINDING A CONTEXT 451=head2 CREATING/FINDING/DESTROYING CONTEXTS
389 452
390=over 4 453=over 4
391 454
392=item $ctx = AnyEvent::Log::ctx [$pkg] 455=item $ctx = AnyEvent::Log::ctx [$pkg]
393 456
411 : defined $pkg 474 : defined $pkg
412 ? $CTX{$pkg} ||= AnyEvent::Log::_pkg_ctx $pkg 475 ? $CTX{$pkg} ||= AnyEvent::Log::_pkg_ctx $pkg
413 : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx" 476 : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx"
414} 477}
415 478
416# create default root context 479=item AnyEvent::Log::reset
417{ 480
418 my $root = ctx undef; 481Resets all package contexts and recreates the default hierarchy if
419 $root->[0] = ""; 482necessary, i.e. resets the logging subsystem to defaults, as much as
420 $root->title ("default"); 483possible. This process keeps references to contexts held by other parts of
421 $root->level ($AnyEvent::VERBOSE); undef $AnyEvent::VERBOSE; 484the program intact.
485
486This can be used to implement config-file (re-)loading: before loading a
487configuration, reset all contexts.
488
489=cut
490
491sub reset {
492 # hard to kill complex data structures
493 # we "recreate" all package loggers and reset the hierarchy
494 while (my ($k, $v) = each %CTX) {
495 @$v = ($k, (1 << 10) - 1 - 1, { });
496
497 $v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log::COLLECT);
498 }
499
500 @$_ = ($_->[0], (1 << 10) - 1 - 1)
501 for $LOG, $FILTER, $COLLECT;
502
503 $LOG->slaves;
504 $LOG->title ('$AnyEvent::Log::LOG');
422 $root->log_cb (sub { 505 $LOG->log_cb (sub {
423 print STDERR shift; 506 warn shift;
424 0 507 0
425 }); 508 });
426 $CTX{""} = $root; 509
510 $FILTER->slaves ($LOG);
511 $FILTER->title ('$AnyEvent::Log::FILTER');
512 $FILTER->level ($AnyEvent::VERBOSE);
513
514 $COLLECT->slaves ($FILTER);
515 $COLLECT->title ('$AnyEvent::Log::COLLECT');
516
517 _reassess;
427} 518}
519
520# create the default logger contexts
521$LOG = ctx undef;
522$FILTER = ctx undef;
523$COLLECT = ctx undef;
524
525AnyEvent::Log::reset;
526
527# hello, CPAN, please catch me
528package AnyEvent::Log::LOG;
529package AE::Log::LOG;
530package AnyEvent::Log::FILTER;
531package AE::Log::FILTER;
532package AnyEvent::Log::COLLECT;
533package AE::Log::COLLECT;
534
535package AnyEvent::Log::Ctx;
536
537# 0 1 2 3 4
538# [$title, $level, %$slaves, &$logcb, &$fmtcb]
539
540=item $ctx = new AnyEvent::Log::Ctx methodname => param...
541
542This is a convenience constructor that makes it simpler to construct
543anonymous logging contexts.
544
545Each key-value pair results in an invocation of the method of the same
546name as the key with the value as parameter, unless the value is an
547arrayref, in which case it calls the method with the contents of the
548array. The methods are called in the same order as specified.
549
550Example: create a new logging context and set both the default logging
551level, some slave contexts and a logging callback.
552
553 $ctx = new AnyEvent::Log::Ctx
554 title => "dubious messages",
555 level => "error",
556 log_cb => sub { print STDOUT shift; 0 },
557 slaves => [$ctx1, $ctx, $ctx2],
558 ;
428 559
429=back 560=back
430 561
431=cut 562=cut
432 563
433package AnyEvent::Log::Ctx; 564sub new {
565 my $class = shift;
434 566
435# 0 1 2 3 4 567 my $ctx = AnyEvent::Log::ctx undef;
436# [$title, $level, %$parents, &$logcb, &$fmtcb] 568
569 while (@_) {
570 my ($k, $v) = splice @_, 0, 2;
571 $ctx->$k (ref $v eq "ARRAY" ? @$v : $v);
572 }
573
574 bless $ctx, $class # do we really support subclassing, hmm?
575}
576
437 577
438=head2 CONFIGURING A LOG CONTEXT 578=head2 CONFIGURING A LOG CONTEXT
439 579
440The following methods can be used to configure the logging context. 580The following methods can be used to configure the logging context.
441 581
535 AnyEvent::Log::_reassess; 675 AnyEvent::Log::_reassess;
536} 676}
537 677
538=back 678=back
539 679
540=head3 PARENT CONTEXTS 680=head3 SLAVE CONTEXTS
541 681
542The following methods attach and detach another logging context to a 682The following methods attach and detach another logging context to a
543logging context. 683logging context.
544 684
545Log messages are propagated to all parent contexts, unless the logging 685Log messages are propagated to all slave contexts, unless the logging
546callback consumes the message. 686callback consumes the message.
547 687
548=over 4 688=over 4
549 689
550=item $ctx->attach ($ctx2[, $ctx3...]) 690=item $ctx->attach ($ctx2[, $ctx3...])
551 691
552Attaches the given contexts as parents to this context. It is not an error 692Attaches the given contexts as slaves to this context. It is not an error
553to add a context twice (the second add will be ignored). 693to add a context twice (the second add will be ignored).
554 694
555A context can be specified either as package name or as a context object. 695A context can be specified either as package name or as a context object.
556 696
557=item $ctx->detach ($ctx2[, $ctx3...]) 697=item $ctx->detach ($ctx2[, $ctx3...])
558 698
559Removes the given parents from this context - it's not an error to attempt 699Removes the given slaves from this context - it's not an error to attempt
560to remove a context that hasn't been added. 700to remove a context that hasn't been added.
561 701
562A context can be specified either as package name or as a context object. 702A context can be specified either as package name or as a context object.
703
704=item $ctx->slaves ($ctx2[, $ctx3...])
705
706Replaces all slaves attached to this context by the ones given.
563 707
564=cut 708=cut
565 709
566sub attach { 710sub attach {
567 my $ctx = shift; 711 my $ctx = shift;
575 719
576 delete $ctx->[2]{$_+0} 720 delete $ctx->[2]{$_+0}
577 for map { AnyEvent::Log::ctx $_ } @_; 721 for map { AnyEvent::Log::ctx $_ } @_;
578} 722}
579 723
724sub slaves {
725 undef $_[0][2];
726 &attach;
727}
728
580=back 729=back
581 730
582=head3 MESSAGE LOGGING 731=head3 LOG TARGETS
583 732
584The following methods configure how the logging context actually does 733The following methods configure how the logging context actually does
585the logging (which consists of formatting the message and printing it or 734the logging (which consists of formatting the message and printing it or
586whatever it wants to do with it) and also allows you to log messages 735whatever it wants to do with it).
587directly to a context, without going via your package context.
588 736
589=over 4 737=over 4
590 738
591=item $ctx->log_cb ($cb->($str)) 739=item $ctx->log_cb ($cb->($str, $orig_ctx, $level))
592 740
593Replaces the logging callback on the context (C<undef> disables the 741Replaces the logging callback on the context (C<undef> disables the
594logging callback). 742logging callback).
595 743
596The logging callback is responsible for handling formatted log messages 744The logging callback is responsible for handling formatted log messages
597(see C<fmt_cb> below) - normally simple text strings that end with a 745(see C<fmt_cb> below) - normally simple text strings that end with a
598newline (and are possibly multiline themselves). 746newline (and are possibly multiline themselves). In addition to the
747message, which is often the only argument you need to look at, it is
748passed the numeric log level and originating context.
599 749
600It also has to return true iff it has consumed the log message, and false 750It also has to return true iff it has consumed the log message, and false
601if it hasn't. Consuming a message means that it will not be sent to any 751if it hasn't. Consuming a message means that it will not be sent to any
602parent context. When in doubt, return C<0> from your logging callback. 752slave context. When in doubt, return C<0> from your logging callback.
603 753
604Example: a very simple logging callback, simply dump the message to STDOUT 754Example: a very simple logging callback, simply dump the message to STDOUT
605and do not consume it. 755and do not consume it.
606 756
607 $ctx->log_cb (sub { print STDERR shift; 0 }); 757 $ctx->log_cb (sub { print STDERR shift; 0 });
615your program. 765your program.
616 766
617 $ctx->levels ("debug", "trace"); 767 $ctx->levels ("debug", "trace");
618 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages 768 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
619 769
770=item $ctx->log_to_file ($path)
771
772Sets the C<log_cb> to log to a file (by appending), unbuffered.
773
774=item $ctx->log_to_path ($path)
775
776Same as C<< ->log_to_file >>, but opens the file for each message. This
777is much slower, but allows you to change/move/rename/delete the file at
778basically any time.
779
780=item $ctx->log_to_syslog ([$log_flags])
781
782Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and all
783the others in the obvious way. If specified, then the C<$log_flags> are
784simply or'ed onto the priority argument and can contain any C<LOG_xxx>
785flags valid for Sys::Syslog::syslog, except for the priority levels.
786
787Note that the default logging format includes a verbose timestamp, which
788is not so suited for syslog, so a simpler C<fmt_cb> might be useful:
789
790 $ctx->log_to_syslog;
791 $ctx->fmt_cb (sub { "($_[1][0]) $_[3]" });
792
620=item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message)) 793=item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
621 794
622Replaces the formatting callback on the context (C<undef> restores the 795Replaces the formatting callback on the context (C<undef> restores the
623default formatter). 796default formatter).
624 797
625The callback is passed the (possibly fractional) timestamp, the original 798The callback is passed the (possibly fractional) timestamp, the original
626logging context, the (numeric) logging level and the raw message string and needs to 799logging context, the (numeric) logging level and the raw message string
627return a formatted log message. In most cases this will be a string, but 800and needs to return a formatted log message. In most cases this will be a
628it could just as well be an array reference that just stores the values. 801string, but it could just as well be an array reference that just stores
802the values.
803
804If, for some reaosn, you want to use C<caller> to find out more baout the
805logger then you should walk up the call stack until you are no longer
806inside the C<AnyEvent::Log> package.
629 807
630Example: format just the raw message, with numeric log level in angle 808Example: format just the raw message, with numeric log level in angle
631brackets. 809brackets.
632 810
633 $ctx->fmt_cb (sub { 811 $ctx->fmt_cb (sub {
664 my ($ctx, $cb) = @_; 842 my ($ctx, $cb) = @_;
665 843
666 $ctx->[4] = $cb; 844 $ctx->[4] = $cb;
667} 845}
668 846
847sub log_to_file {
848 my ($ctx, $path) = @_;
849
850 open my $fh, ">>", $path
851 or die "$path: $!";
852
853 $ctx->log_cb (sub {
854 syswrite $fh, shift;
855 0
856 });
857}
858
859sub log_to_file {
860 my ($ctx, $path) = @_;
861
862 $ctx->log_cb (sub {
863 open my $fh, ">>", $path
864 or die "$path: $!";
865
866 syswrite $fh, shift;
867 0
868 });
869}
870
871sub log_to_syslog {
872 my ($ctx, $flags) = @_;
873
874 require Sys::Syslog;
875
876 $ctx->log_cb (sub {
877 my $lvl = $_[2] < 9 ? $_[2] : 8;
878
879 Sys::Syslog::syslog ($flags | ($lvl - 1), $_)
880 for split /\n/, shift;
881
882 0
883 });
884}
885
886=back
887
888=head3 MESSAGE LOGGING
889
890These methods allow you to log messages directly to a context, without
891going via your package context.
892
893=over 4
894
669=item $ctx->log ($level, $msg[, @params]) 895=item $ctx->log ($level, $msg[, @params])
670 896
671Same as C<AnyEvent::Log::log>, but uses the given context as log context. 897Same as C<AnyEvent::Log::log>, but uses the given context as log context.
672 898
673=item $logger = $ctx->logger ($level[, \$enabled]) 899=item $logger = $ctx->logger ($level[, \$enabled])
682 908
6831; 9091;
684 910
685=back 911=back
686 912
913=head1 EXAMPLES
914
915This section shows some common configurations.
916
917=over 4
918
919=item Setting the global logging level.
920
921Either put PERL_ANYEVENT_VERBOSE=<number> into your environment before
922running your program, or modify the log level of the root context:
923
924 PERL_ANYEVENT_VERBOSE=5 ./myprog
925
926 $AnyEvent::Log::FILTER->level ("warn");
927
928=item Append all messages to a file instead of sending them to STDERR.
929
930This is affected by the global logging level.
931
932 $AnyEvent::Log::LOG->log_to_file ($path); (sub {
933
934=item Write all messages with priority C<error> and higher to a file.
935
936This writes them only when the global logging level allows it, because
937it is attached to the default context which is invoked I<after> global
938filtering.
939
940 $AnyEvent::Log::FILTER->attach
941 new AnyEvent::Log::Ctx log_to_file => $path);
942
943This writes them regardless of the global logging level, because it is
944attached to the toplevel context, which receives all messages I<before>
945the global filtering.
946
947 $AnyEvent::Log::COLLECT->attach (
948 new AnyEvent::Log::Ctx log_to_file => $path);
949
950In both cases, messages are still written to STDERR.
951
952=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
953
954Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
955context - this simply circumvents the global filtering for trace messages.
956
957 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
958 $debug->attach ($AnyEvent::Log::LOG);
959
960This of course works for any package, not just L<AnyEvent::Debug>, but
961assumes the log level for AnyEvent::Debug hasn't been changed from the
962default.
963
964=back
965
687=head1 AUTHOR 966=head1 AUTHOR
688 967
689 Marc Lehmann <schmorp@schmorp.de> 968 Marc Lehmann <schmorp@schmorp.de>
690 http://home.schmorp.de/ 969 http://home.schmorp.de/
691 970

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines