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.54 by root, Tue Mar 27 23:47:57 2012 UTC vs.
Revision 1.73 by root, Sun Apr 24 21:22:38 2022 UTC

8 8
9 use AnyEvent; 9 use AnyEvent;
10 10
11 AE::log fatal => "No config found, cannot continue!"; # never returns 11 AE::log fatal => "No config found, cannot continue!"; # never returns
12 AE::log alert => "The battery died!"; 12 AE::log alert => "The battery died!";
13 AE::log crit => "The battery temperature is too hot!"; 13 AE::log crit => "The battery is too hot!";
14 AE::log error => "Division by zero attempted."; 14 AE::log error => "Division by zero attempted.";
15 AE::log warn => "Couldn't delete the file."; 15 AE::log warn => "Couldn't delete the file.";
16 AE::log note => "Wanted to create config, but config already exists."; 16 AE::log note => "Attempted to create config, but config already exists.";
17 AE::log info => "File soandso successfully deleted."; 17 AE::log info => "File soandso successfully deleted.";
18 AE::log debug => "the function returned 3"; 18 AE::log debug => "the function returned 3";
19 AE::log trace => "going to call function abc"; 19 AE::log trace => "going to call function abc";
20 20
21Log level overview: 21Log level overview:
33 33
34"Complex" uses (for speed sensitive code, e.g. trace/debug messages): 34"Complex" uses (for speed sensitive code, e.g. trace/debug messages):
35 35
36 use AnyEvent::Log; 36 use AnyEvent::Log;
37 37
38 my $tracer = AnyEvent::Log::logger trace => \$my $trace; 38 my $tracer = AnyEvent::Log::logger trace => \my $trace;
39 39
40 $tracer->("i am here") if $trace; 40 $tracer->("i am here") if $trace;
41 $tracer->(sub { "lots of data: " . Dumper $self }) if $trace; 41 $tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
42 42
43Configuration (also look at the EXAMPLES section): 43Configuration (also look at the EXAMPLES section):
44 44
45 # set default logging level to suppress anything below "notice"
46 # i.e. enable logging at "notice" or above - the default is to
47 # to not log anything at all.
48 $AnyEvent::Log::FILTER->level ("notice");
49
45 # set logging for the current package to errors and higher only 50 # set logging for the current package to errors and higher only
46 AnyEvent::Log::ctx->level ("error"); 51 AnyEvent::Log::ctx->level ("error");
47 52
48 # set logging level to suppress anything below "notice" 53 # enable logging for the current package, regardless of global logging level
49 $AnyEvent::Log::FILTER->level ("notice"); 54 AnyEvent::Log::ctx->attach ($AnyEvent::Log::LOG);
55
56 # enable debug logging for module some::mod and enable logging by default
57 (AnyEvent::Log::ctx "some::mod")->level ("debug");
58 (AnyEvent::Log::ctx "some::mod")->attach ($AnyEvent::Log::LOG);
50 59
51 # send all critical and higher priority messages to syslog, 60 # send all critical and higher priority messages to syslog,
52 # regardless of (most) other settings 61 # regardless of (most) other settings
53 $AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx 62 $AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx
54 level => "critical", 63 level => "critical",
71 80
72 use AnyEvent::Log; 81 use AnyEvent::Log;
73 $AnyEvent::Log::FILTER->level ("info"); 82 $AnyEvent::Log::FILTER->level ("info");
74 83
75The design goal behind this module was to keep it simple (and small), 84The design goal behind this module was to keep it simple (and small),
76but make it powerful enough to be potentially useful for any module, and 85but make it powerful enough to be potentially useful for any module,
77extensive enough for the most common tasks, such as logging to multiple 86and extensive enough for the most common tasks, such as logging to
78targets, or being able to log into a database. 87multiple targets, or being able to log into a database.
79 88
80The module is also usable before AnyEvent itself is initialised, in which 89The module is also usable before AnyEvent itself is initialised, in which
81case some of the functionality might be reduced. 90case some of the functionality might be reduced.
82 91
83The amount of documentation might indicate otherwise, but the runtime part 92The amount of documentation might indicate otherwise, but the runtime part
121For example, a program that finds an unknown switch on the commandline 130For example, a program that finds an unknown switch on the commandline
122might well use a fatal logging level to tell users about it - the "system" 131might well use a fatal logging level to tell users about it - the "system"
123in this case would be the program, or module. 132in this case would be the program, or module.
124 133
125Some methods also offer some extra levels, such as C<0>, C<off>, C<none> 134Some methods also offer some extra levels, such as C<0>, C<off>, C<none>
126or C<all> - these are only valid for the methods that documented them. 135or C<all> - these are only valid for the methods that document them.
127 136
128=head1 LOGGING FUNCTIONS 137=head1 LOGGING FUNCTIONS
129 138
130The following functions allow you to log messages. They always use the 139The following functions allow you to log messages. They always use the
131caller's package as a "logging context". Also, the main logging function, 140caller's package as a "logging context". Also, the main logging function,
153our ($COLLECT, $FILTER, $LOG); 162our ($COLLECT, $FILTER, $LOG);
154 163
155our ($now_int, $now_str1, $now_str2); 164our ($now_int, $now_str1, $now_str2);
156 165
157# Format Time, not public - yet? 166# Format Time, not public - yet?
158sub ft($) { 167sub format_time($) {
159 my $i = int $_[0]; 168 my $i = int $_[0];
160 my $f = sprintf "%06d", 1e6 * ($_[0] - $i); 169 my $f = sprintf "%06d", 1e6 * ($_[0] - $i);
161 170
162 ($now_int, $now_str1, $now_str2) = ($i, split /\x01/, POSIX::strftime "%Y-%m-%d %H:%M:%S.\x01 %z", localtime $i) 171 ($now_int, $now_str1, $now_str2) = ($i, split /\x01/, POSIX::strftime "%Y-%m-%d %H:%M:%S.\x01 %z", localtime $i)
163 if $now_int != $i; 172 if $now_int != $i;
262}; 271};
263 272
264our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace); 273our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
265 274
266# time, ctx, level, msg 275# time, ctx, level, msg
267sub _format($$$$) { 276sub default_format($$$$) {
268 my $ts = ft $_[0]; 277 my $ts = format_time $_[0];
269 my $ct = " "; 278 my $ct = " ";
270 279
271 my @res; 280 my @res;
272 281
273 for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) { 282 for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) {
322 }; 331 };
323 332
324 # format msg 333 # format msg
325 my $str = $ctx->[4] 334 my $str = $ctx->[4]
326 ? $ctx->[4]($now, $_[0], $level, $format) 335 ? $ctx->[4]($now, $_[0], $level, $format)
327 : ($fmt[$level] ||= _format $now, $_[0], $level, $format); 336 : ($fmt[$level] ||= default_format $now, $_[0], $level, $format);
328 337
329 $success = 1; 338 $success = 1;
330 339
331 $ctx->[3]($str) 340 $ctx->[3]($str)
332 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate 341 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
449time on each log message. This only makes a difference for event loops 458time on each log message. This only makes a difference for event loops
450that actually cache the time (such as L<EV> or L<AnyEvent::Loop>). 459that actually cache the time (such as L<EV> or L<AnyEvent::Loop>).
451 460
452This setting can be changed at any time by calling this function. 461This setting can be changed at any time by calling this function.
453 462
454Since C<AnyEvent::Log> has to work even before the L<AnyEvent> has been 463Since C<AnyEvent::Log> has to work even before L<AnyEvent> has been
455initialised, this switch will also decide whether to use C<CORE::time> or 464initialised, this switch will also decide whether to use C<CORE::time> or
456C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes 465C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes
457available. 466available.
467
468=item AnyEvent::Log::format_time $timestamp
469
470Formats a timestamp as returned by C<< AnyEvent->now >> or C<<
471AnyEvent->time >> or many other functions in the same way as
472C<AnyEvent::Log> does.
473
474In your main program (as opposed to in your module) you can override
475the default timestamp display format by loading this module and then
476redefining this function.
477
478Most commonly, this function can be used in formatting callbacks.
479
480=item AnyEvent::Log::default_format $time, $ctx, $level, $msg
481
482Format a log message using the given timestamp, logging context, log level
483and log message.
484
485This is the formatting function used to format messages when no custom
486function is provided.
487
488In your main program (as opposed to in your module) you can override the
489default message format by loading this module and then redefining this
490function.
491
492=item AnyEvent::Log::fatal_exit()
493
494This is the function that is called after logging a C<fatal> log
495message. It must not return.
496
497The default implementation simply calls C<exit 1>.
498
499In your main program (as opposed to in your module) you can override
500the fatal exit function by loading this module and then redefining this
501function. Make sure you don't return.
458 502
459=back 503=back
460 504
461=head1 LOGGING CONTEXTS 505=head1 LOGGING CONTEXTS
462 506
486context, so it does not matter (much) if there are cycles or if the 530context, so it does not matter (much) if there are cycles or if the
487message can arrive at the same context via multiple paths. 531message can arrive at the same context via multiple paths.
488 532
489=head2 DEFAULTS 533=head2 DEFAULTS
490 534
491By default, all logging contexts have an full set of log levels ("all"), a 535By default, all logging contexts have a full set of log levels ("all"), a
492disabled logging callback and the default formatting callback. 536disabled logging callback and the default formatting callback.
493 537
494Package contexts have the package name as logging title by default. 538Package contexts have the package name as logging title by default.
495 539
496They have exactly one slave - the context of the "parent" package. The 540They have exactly one slave - the context of the "parent" package. The
550 594
551=item $ctx = AnyEvent::Log::ctx [$pkg] 595=item $ctx = AnyEvent::Log::ctx [$pkg]
552 596
553This function creates or returns a logging context (which is an object). 597This function creates or returns a logging context (which is an object).
554 598
555If a package name is given, then the context for that packlage is 599If a package name is given, then the context for that package is
556returned. If it is called without any arguments, then the context for the 600returned. If it is called without any arguments, then the context for the
557callers package is returned (i.e. the same context as a C<AE::log> call 601callers package is returned (i.e. the same context as a C<AE::log> call
558would use). 602would use).
559 603
560If C<undef> is given, then it creates a new anonymous context that is not 604If C<undef> is given, then it creates a new anonymous context that is not
840sub attach { 884sub attach {
841 my $ctx = shift; 885 my $ctx = shift;
842 886
843 $ctx->[2]{$_+0} = $_ 887 $ctx->[2]{$_+0} = $_
844 for map { AnyEvent::Log::ctx $_ } @_; 888 for map { AnyEvent::Log::ctx $_ } @_;
889 AnyEvent::Log::_reassess;
845} 890}
846 891
847sub detach { 892sub detach {
848 my $ctx = shift; 893 my $ctx = shift;
849 894
850 delete $ctx->[2]{$_+0} 895 delete $ctx->[2]{$_+0}
851 for map { AnyEvent::Log::ctx $_ } @_; 896 for map { AnyEvent::Log::ctx $_ } @_;
897 AnyEvent::Log::_reassess;
852} 898}
853 899
854sub slaves { 900sub slaves {
855 undef $_[0][2]; 901 undef $_[0][2];
856 &attach; 902 &attach;
903 AnyEvent::Log::_reassess;
857} 904}
858 905
859=back 906=back
860 907
861=head3 LOG TARGETS 908=head3 LOG TARGETS
864the logging (which consists of formatting the message and printing it or 911the logging (which consists of formatting the message and printing it or
865whatever it wants to do with it). 912whatever it wants to do with it).
866 913
867=over 4 914=over 4
868 915
869=item $ctx->log_cb ($cb->($str) 916=item $ctx->log_cb ($cb->($str))
870 917
871Replaces the logging callback on the context (C<undef> disables the 918Replaces the logging callback on the context (C<undef> disables the
872logging callback). 919logging callback).
873 920
874The logging callback is responsible for handling formatted log messages 921The logging callback is responsible for handling formatted log messages
908 955
909If, for some reason, you want to use C<caller> to find out more about the 956If, for some reason, you want to use C<caller> to find out more about the
910logger then you should walk up the call stack until you are no longer 957logger then you should walk up the call stack until you are no longer
911inside the C<AnyEvent::Log> package. 958inside the C<AnyEvent::Log> package.
912 959
960To implement your own logging callback, you might find the
961C<AnyEvent::Log::format_time> and C<AnyEvent::Log::default_format>
962functions useful.
963
964Example: format the message just as AnyEvent::Log would, by letting
965AnyEvent::Log do the work. This is a good basis to design a formatting
966callback that only changes minor aspects of the formatting.
967
968 $ctx->fmt_cb (sub {
969 my ($time, $ctx, $lvl, $msg) = @_;
970
971 AnyEvent::Log::default_format $time, $ctx, $lvl, $msg
972 });
973
913Example: format just the raw message, with numeric log level in angle 974Example: format just the raw message, with numeric log level in angle
914brackets. 975brackets.
915 976
916 $ctx->fmt_cb (sub { 977 $ctx->fmt_cb (sub {
917 my ($time, $ctx, $lvl, $msg) = @_; 978 my ($time, $ctx, $lvl, $msg) = @_;
940Sets the C<log_cb> to simply use C<CORE::warn> to report any messages 1001Sets the C<log_cb> to simply use C<CORE::warn> to report any messages
941(usually this logs to STDERR). 1002(usually this logs to STDERR).
942 1003
943=item $ctx->log_to_file ($path) 1004=item $ctx->log_to_file ($path)
944 1005
945Sets the C<log_cb> to log to a file (by appending), unbuffered. 1006Sets the C<log_cb> to log to a file (by appending), unbuffered. The
1007function might return before the log file has been opened or created.
946 1008
947=item $ctx->log_to_path ($path) 1009=item $ctx->log_to_path ($path)
948 1010
949Same as C<< ->log_to_file >>, but opens the file for each message. This 1011Same as C<< ->log_to_file >>, but opens the file for each message. This
950is much slower, but allows you to change/move/rename/delete the file at 1012is much slower, but allows you to change/move/rename/delete the file at
985 warn shift; 1047 warn shift;
986 0 1048 0
987 }); 1049 });
988} 1050}
989 1051
1052# this function is a good example of why threads are a must,
1053# simply for priority inversion.
1054sub _log_to_disk {
1055 # eval'uating this at runtime saves 220kb rss - perl has become
1056 # an insane memory waster.
1057 eval q{ # poor man's autoloading {}
1058 sub _log_to_disk {
1059 my ($ctx, $path, $keepopen) = @_;
1060
1061 my $fh;
1062 my @queue;
1063 my $delay;
1064 my $disable;
1065
1066 use AnyEvent::IO ();
1067
1068 my $kick = sub {
1069 undef $delay;
1070 return unless @queue;
1071 $delay = 1;
1072
1073 # we pass $kick to $kick, so $kick itself doesn't keep a reference to $kick.
1074 my $kick = shift;
1075
1076 # write one or more messages
1077 my $write = sub {
1078 # we write as many messages as have been queued
1079 my $data = join "", @queue;
1080 @queue = ();
1081
1082 AnyEvent::IO::aio_write $fh, $data, sub {
1083 $disable = 1;
1084 @_
1085 ? ($_[0] == length $data or AE::log 4 => "unable to write to logfile '$path': short write")
1086 : AE::log 4 => "unable to write to logfile '$path': $!";
1087 undef $disable;
1088
1089 if ($keepopen) {
1090 $kick->($kick);
1091 } else {
1092 AnyEvent::IO::aio_close ($fh, sub {
1093 undef $fh;
1094 $kick->($kick);
1095 });
1096 }
1097 };
1098 };
1099
1100 if ($fh) {
1101 $write->();
1102 } else {
1103 AnyEvent::IO::aio_open
1104 $path,
1105 AnyEvent::IO::O_CREAT | AnyEvent::IO::O_WRONLY | AnyEvent::IO::O_APPEND,
1106 0666,
1107 sub {
1108 $fh = shift
1109 or do {
1110 $disable = 1;
1111 AE::log 4 => "unable to open logfile '$path': $!";
1112 undef $disable;
1113 return;
1114 };
1115
1116 $write->();
1117 }
1118 ;
1119 }
1120 };
1121
1122 $ctx->log_cb (sub {
1123 return if $disable;
1124 push @queue, shift;
1125 $kick->($kick) unless $delay;
1126 0
1127 });
1128
1129 $kick->($kick) if $keepopen; # initial open
1130 };
1131 };
1132 die if $@;
1133 &_log_to_disk
1134}
1135
990sub log_to_file { 1136sub log_to_file {
991 my ($ctx, $path) = @_; 1137 my ($ctx, $path) = @_;
992 1138
993 open my $fh, ">>", $path 1139 _log_to_disk $ctx, $path, 1;
994 or die "$path: $!";
995
996 $ctx->log_cb (sub {
997 syswrite $fh, shift;
998 0
999 });
1000} 1140}
1001 1141
1002sub log_to_path { 1142sub log_to_path {
1003 my ($ctx, $path) = @_; 1143 my ($ctx, $path) = @_;
1004 1144
1005 $ctx->log_cb (sub { 1145 _log_to_disk $ctx, $path, 0;
1006 open my $fh, ">>", $path
1007 or die "$path: $!";
1008
1009 syswrite $fh, shift;
1010 0
1011 });
1012} 1146}
1013 1147
1014sub log_to_syslog { 1148sub log_to_syslog {
1015 my ($ctx, $facility) = @_; 1149 my ($ctx, $facility) = @_;
1016 1150
1105=item C<%name> 1239=item C<%name>
1106 1240
1107Context names starting with a C<%> are anonymous contexts created when the 1241Context names starting with a C<%> are anonymous contexts created when the
1108name is first mentioned. The difference to package contexts is that by 1242name is first mentioned. The difference to package contexts is that by
1109default they have no attached slaves. 1243default they have no attached slaves.
1244
1245This makes it possible to create new log contexts that can be refered to
1246multiple times by name within the same log specification.
1110 1247
1111=item a perl package name 1248=item a perl package name
1112 1249
1113Any other string references the logging context associated with the given 1250Any other string references the logging context associated with the given
1114Perl C<package>. In the unlikely case where you want to specify a package 1251Perl C<package>. In the unlikely case where you want to specify a package
1374assumes the log level for AnyEvent::Debug hasn't been changed from the 1511assumes the log level for AnyEvent::Debug hasn't been changed from the
1375default. 1512default.
1376 1513
1377=back 1514=back
1378 1515
1516=head1 ASYNCHRONOUS DISK I/O
1517
1518This module uses L<AnyEvent::IO> to actually write log messages (in
1519C<log_to_file> and C<log_to_path>), so it doesn't block your program when
1520the disk is busy and a non-blocking L<AnyEvent::IO> backend is available.
1521
1379=head1 AUTHOR 1522=head1 AUTHOR
1380 1523
1381 Marc Lehmann <schmorp@schmorp.de> 1524 Marc Lehmann <schmorp@schmorp.de>
1382 http://home.schmorp.de/ 1525 http://anyevent.schmorp.de
1383 1526
1384=cut 1527=cut
1385 1528
13861 15291
1387 1530

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines