… | |
… | |
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, $_[0], $level) |
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 |
255 | } |
255 | } |
256 | } |
256 | } |
… | |
… | |
734 | the logging (which consists of formatting the message and printing it or |
734 | the logging (which consists of formatting the message and printing it or |
735 | whatever it wants to do with it). |
735 | whatever it wants to do with it). |
736 | |
736 | |
737 | =over 4 |
737 | =over 4 |
738 | |
738 | |
739 | =item $ctx->log_cb ($cb->($str, $orig_ctx, $level)) |
739 | =item $ctx->log_cb ($cb->($str) |
740 | |
740 | |
741 | Replaces the logging callback on the context (C<undef> disables the |
741 | Replaces the logging callback on the context (C<undef> disables the |
742 | logging callback). |
742 | logging callback). |
743 | |
743 | |
744 | The logging callback is responsible for handling formatted log messages |
744 | The logging callback is responsible for handling formatted log messages |
745 | (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 |
746 | newline (and are possibly multiline themselves). In addition to the |
746 | newline (and are possibly multiline themselves). |
747 | message, which is often the only argument you need to look at, it is |
|
|
748 | passed the numeric log level and originating context. |
|
|
749 | |
747 | |
750 | It also has to return true iff it has consumed the log message, and false |
748 | It also has to return true iff it has consumed the log message, and false |
751 | if it hasn't. Consuming a message means that it will not be sent to any |
749 | if it hasn't. Consuming a message means that it will not be sent to any |
752 | slave context. When in doubt, return C<0> from your logging callback. |
750 | slave context. When in doubt, return C<0> from your logging callback. |
753 | |
751 | |
… | |
… | |
764 | "trace". The messages will still be generated, though, which can slow down |
762 | "trace". The messages will still be generated, though, which can slow down |
765 | your program. |
763 | your program. |
766 | |
764 | |
767 | $ctx->levels ("debug", "trace"); |
765 | $ctx->levels ("debug", "trace"); |
768 | $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 |
769 | |
|
|
770 | =item $ctx->log_to_file ($path) |
|
|
771 | |
|
|
772 | Sets the C<log_cb> to log to a file (by appending), unbuffered. |
|
|
773 | |
|
|
774 | =item $ctx->log_to_path ($path) |
|
|
775 | |
|
|
776 | Same as C<< ->log_to_file >>, but opens the file for each message. This |
|
|
777 | is much slower, but allows you to change/move/rename/delete the file at |
|
|
778 | basically any time. |
|
|
779 | |
|
|
780 | =item $ctx->log_to_syslog ([$log_flags]) |
|
|
781 | |
|
|
782 | Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and all |
|
|
783 | the others in the obvious way. If specified, then the C<$log_flags> are |
|
|
784 | simply or'ed onto the priority argument and can contain any C<LOG_xxx> |
|
|
785 | flags valid for Sys::Syslog::syslog, except for the priority levels. |
|
|
786 | |
|
|
787 | Note that the default logging format includes a verbose timestamp, which |
|
|
788 | is 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 | |
767 | |
793 | =item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message)) |
768 | =item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message)) |
794 | |
769 | |
795 | Replaces the formatting callback on the context (C<undef> restores the |
770 | Replaces the formatting callback on the context (C<undef> restores the |
796 | default formatter). |
771 | default formatter). |
… | |
… | |
828 | "$msg->[3]"; |
803 | "$msg->[3]"; |
829 | |
804 | |
830 | 0 |
805 | 0 |
831 | }); |
806 | }); |
832 | |
807 | |
|
|
808 | =item $ctx->log_to_file ($path) |
|
|
809 | |
|
|
810 | Sets the C<log_cb> to log to a file (by appending), unbuffered. |
|
|
811 | |
|
|
812 | =item $ctx->log_to_path ($path) |
|
|
813 | |
|
|
814 | Same as C<< ->log_to_file >>, but opens the file for each message. This |
|
|
815 | is much slower, but allows you to change/move/rename/delete the file at |
|
|
816 | basically any time. |
|
|
817 | |
|
|
818 | =item $ctx->log_to_syslog ([$log_flags]) |
|
|
819 | |
|
|
820 | Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and all |
|
|
821 | the others in the obvious way. If specified, then the C<$log_flags> are |
|
|
822 | simply or'ed onto the priority argument and can contain any C<LOG_xxx> |
|
|
823 | flags valid for Sys::Syslog::syslog, except for the priority levels. |
|
|
824 | |
|
|
825 | Note that this function also sets a C<fmt_cb> - the logging part requires |
|
|
826 | an array reference with [$level, $str] as input. |
|
|
827 | |
833 | =cut |
828 | =cut |
834 | |
829 | |
835 | sub log_cb { |
830 | sub log_cb { |
836 | my ($ctx, $cb) = @_; |
831 | my ($ctx, $cb) = @_; |
837 | |
832 | |
… | |
… | |
871 | sub log_to_syslog { |
866 | sub log_to_syslog { |
872 | my ($ctx, $flags) = @_; |
867 | my ($ctx, $flags) = @_; |
873 | |
868 | |
874 | require Sys::Syslog; |
869 | require Sys::Syslog; |
875 | |
870 | |
|
|
871 | $ctx->fmt_cb (sub { |
|
|
872 | my $str = $_[3]; |
|
|
873 | $str =~ s/\n(?=.)/\n+ /g; |
|
|
874 | |
|
|
875 | [$_[2], "($_[1][0]) $str"] |
|
|
876 | }); |
|
|
877 | |
876 | $ctx->log_cb (sub { |
878 | $ctx->log_cb (sub { |
877 | my $lvl = $_[2] < 9 ? $_[2] : 8; |
879 | my $lvl = $_[0][0] < 9 ? $_[0][0] : 8; |
878 | |
880 | |
879 | Sys::Syslog::syslog ($flags | ($lvl - 1), $_) |
881 | Sys::Syslog::syslog ($flags | ($lvl - 1), $_) |
880 | for split /\n/, shift; |
882 | for split /\n/, $_[0][1]; |
881 | |
883 | |
882 | 0 |
884 | 0 |
883 | }); |
885 | }); |
884 | } |
886 | } |
885 | |
887 | |