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.18 by root, Sat Aug 20 15:57:35 2011 UTC vs.
Revision 1.21 by root, Sat Aug 20 22:33:08 2011 UTC

… …
36attempt to be "the" logging solution or even "a" logging solution for 36attempt to be "the" logging solution or even "a" logging solution for
37AnyEvent - AnyEvent simply creates logging messages internally, and this 37AnyEvent - AnyEvent simply creates logging messages internally, and this
38module 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
39using it from other modules as well. 39using it from other modules as well.
40 40
41Remember 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
42logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number before 42will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
43starting your program, or change the logging level at runtime with 43before starting your program, or change the logging level at runtime with
44something like: 44something like:
45 45
46 use AnyEvent::Log; 46 use AnyEvent::Log;
47 AnyEvent::Log::FILTER->level ("info"); 47 AnyEvent::Log::FILTER->level ("info");
48 48
… …
244 }; 244 };
245 245
246 # format msg 246 # format msg
247 my $str = $ctx->[4] 247 my $str = $ctx->[4]
248 ? $ctx->[4]($now, $_[0], $level, $format) 248 ? $ctx->[4]($now, $_[0], $level, $format)
249 : $fmt ||= _format $now, $_[0], $level, $format; 249 : ($fmt ||= _format $now, $_[0], $level, $format);
250 250
251 $ctx->[3]($str) 251 $ctx->[3]($str)
252 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate 252 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
253 } else { 253 } else {
254 push @ctx, values %{ $ctx->[2] }; # not masked - propagate 254 push @ctx, values %{ $ctx->[2] }; # not masked - propagate
… …
488 488
489=cut 489=cut
490 490
491sub reset { 491sub reset {
492 # hard to kill complex data structures 492 # hard to kill complex data structures
493 # we recreate all package loggers and reset the hierarchy 493 # we "recreate" all package loggers and reset the hierarchy
494 while (my ($k, $v) = each %CTX) { 494 while (my ($k, $v) = each %CTX) {
495 @$v = ($k, (1 << 10) - 1 - 1, { }); 495 @$v = ($k, (1 << 10) - 1 - 1, { });
496 496
497 $v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log); 497 $v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log::COLLECT);
498 } 498 }
499
500 @$_ = ($_->[0], (1 << 10) - 1 - 1)
501 for $LOG, $FILTER, $COLLECT;
499 502
500 $LOG->slaves; 503 $LOG->slaves;
501 $LOG->title ('$AnyEvent::Log::LOG'); 504 $LOG->title ('$AnyEvent::Log::LOG');
502 $LOG->log_cb (sub { 505 $LOG->log_cb (sub {
503 warn shift; 506 warn shift;
… …
507 $FILTER->slaves ($LOG); 510 $FILTER->slaves ($LOG);
508 $FILTER->title ('$AnyEvent::Log::FILTER'); 511 $FILTER->title ('$AnyEvent::Log::FILTER');
509 $FILTER->level ($AnyEvent::VERBOSE); 512 $FILTER->level ($AnyEvent::VERBOSE);
510 513
511 $COLLECT->slaves ($FILTER); 514 $COLLECT->slaves ($FILTER);
512 $COLLECT->title ('$AnyEvent::Log::FILTER'); 515 $COLLECT->title ('$AnyEvent::Log::COLLECT');
513 516
514 _reassess; 517 _reassess;
515} 518}
516 519
517# create the default logger contexts 520# create the default logger contexts
… …
731the logging (which consists of formatting the message and printing it or 734the logging (which consists of formatting the message and printing it or
732whatever it wants to do with it). 735whatever it wants to do with it).
733 736
734=over 4 737=over 4
735 738
736=item $ctx->log_cb ($cb->($str)) 739=item $ctx->log_cb ($cb->($str)
737 740
738Replaces the logging callback on the context (C<undef> disables the 741Replaces the logging callback on the context (C<undef> disables the
739logging callback). 742logging callback).
740 743
741The logging callback is responsible for handling formatted log messages 744The logging callback is responsible for handling formatted log messages
… …
760your program. 763your program.
761 764
762 $ctx->levels ("debug", "trace"); 765 $ctx->levels ("debug", "trace");
763 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages 766 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
764 767
765=item $ctx->log_to_file ($path)
766
767Sets the C<log_cb> to log to a file (by appending), unbuffered.
768
769=item $ctx->log_to_path ($path)
770
771Same as C<< ->log_to_file >>, but opens the file for each message. This
772is much slower, but allows you to change/move/rename/delete the file at
773basically any time.
774
775=item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message)) 768=item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
776 769
777Replaces the formatting callback on the context (C<undef> restores the 770Replaces the formatting callback on the context (C<undef> restores the
778default formatter). 771default formatter).
779 772
780The callback is passed the (possibly fractional) timestamp, the original 773The callback is passed the (possibly fractional) timestamp, the original
… …
810 "$msg->[3]"; 803 "$msg->[3]";
811 804
812 0 805 0
813 }); 806 });
814 807
808=item $ctx->log_to_file ($path)
809
810Sets the C<log_cb> to log to a file (by appending), unbuffered.
811
812=item $ctx->log_to_path ($path)
813
814Same as C<< ->log_to_file >>, but opens the file for each message. This
815is much slower, but allows you to change/move/rename/delete the file at
816basically any time.
817
818=item $ctx->log_to_syslog ([$log_flags])
819
820Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and all
821the others in the obvious way. If specified, then the C<$log_flags> are
822simply or'ed onto the priority argument and can contain any C<LOG_xxx>
823flags valid for Sys::Syslog::syslog, except for the priority levels.
824
825Note that this function also sets a C<fmt_cb> - the logging part requires
826an array reference with [$level, $str] as input.
827
815=cut 828=cut
816 829
817sub log_cb { 830sub log_cb {
818 my ($ctx, $cb) = @_; 831 my ($ctx, $cb) = @_;
819 832
… …
848 syswrite $fh, shift; 861 syswrite $fh, shift;
849 0 862 0
850 }); 863 });
851} 864}
852 865
866sub log_to_syslog {
867 my ($ctx, $flags) = @_;
868
869 require Sys::Syslog;
870
871 $ctx->fmt_cb (sub {
872 my $str = $_[3];
873 $str =~ s/\n(?=.)/\n+ /g;
874
875 [$_[2], "($_[1][0]) $str"]
876 });
877
878 $ctx->log_cb (sub {
879 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
880
881 Sys::Syslog::syslog ($flags | ($lvl - 1), $_)
882 for split /\n/, $_[0][1];
883
884 0
885 });
886}
887
853=back 888=back
854 889
855=head3 MESSAGE LOGGING 890=head3 MESSAGE LOGGING
856 891
857These methods allow you to log messages directly to a context, without 892These methods allow you to log messages directly to a context, without

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines