Added log_format configuration setting

2 files changed, 32 insertions, 7 deletions

diff --git a/lib/TUWF.pm b/lib/TUWF.pm
index 77fb8a5..5a05a29 100644
--- a/lib/TUWF.pm
+++ b/lib/TUWF.pm
@@ -23,6 +23,10 @@ our $OBJ = bless {
     error_405_handler => \&_error_405,
     error_413_handler => \&_error_413,
     error_500_handler => \&_error_500,
+    log_format => sub {
+      my($self, $uri, $msg) = @_;
+      sprintf "[%s] %s -> %s\n", scalar localtime(), $uri, $msg;
+    },
   }
 }, 'TUWF::Object';
 
@@ -283,12 +287,10 @@ sub _handle_request {
     my($sqlt, $sqlc) = (0, 0);
     if($self->{_TUWF}{db_login}) {
       $sqlc = grep $_->[0] ne 'ping/rollback' && $_->[0] ne 'commit', @{$self->{_TUWF}{DB}{queries}};
-      $sqlt += $_->[1]*1000
-        for (@{$self->{_TUWF}{DB}{queries}});
+      $sqlt += $_->[1]*1000 for (@{$self->{_TUWF}{DB}{queries}});
     }
 
-    $self->log(sprintf('%4dms (SQL:%4dms,%3d qs)',
-      $time, $sqlt, $sqlc, $self->reqURI), 1);
+    $self->log(sprintf('%4dms (SQL:%4dms,%3d qs)', $time, $sqlt, $sqlc, $self->reqURI));
   }
 }
 
@@ -302,15 +304,22 @@ sub debug {
 # writes a message to the log file. date, time and URL are automatically added
 sub log {
   my($self, $msg) = @_;
+
+  # temporarily disable the warnings-to-log, to avoid infinite recursion if
+  # this function throws a warning.
+  my $old = $SIG{__WARN__};
+  $SIG{__WARN__} = undef;
+
   chomp $msg;
   $msg =~ s/\n/\n  | /g;
   if($self->{_TUWF}{logfile} && open my $F, '>>:utf8', $self->{_TUWF}{logfile}) {
     flock $F, 2;
     seek $F, 0, 2;
-    printf $F "[%s] %s -> %s\n", scalar localtime(), $self->{_TUWF}{Req} ? $self->reqURI : '[init]', $msg;
+    print $F $self->{_TUWF}{log_format}->($self, $self->{_TUWF}{Req} ? $self->reqURI : '[init]', $msg);
     flock $F, 4;
     close $F;
   }
+  $SIG{__WARN__} = $old;
 }
 
 
diff --git a/lib/TUWF.pod b/lib/TUWF.pod
index 12a9d62..d993dd1 100644
--- a/lib/TUWF.pod
+++ b/lib/TUWF.pod
@@ -362,6 +362,21 @@ full request dump with useful information will be logged, allowing you to
 easily locate and fix the problem. You can also write information to the log
 yourself using the C<log()> method. Default: undef (disabled).
 
+=item log_format
+
+Set to a subroutine reference to influence the default log format. The
+subroutine is passed three arguments: the main TUWF object, the URI of the
+current request (or '[init]' if C<log()> was called outside of a request), and
+the log message. The subroutine should return the string to be written to the
+log, including trailing newline.
+
+Be warned that your subroutine can be called even when no request is being
+processed or before some resources have been initialized, so you should avoid
+using such resources. In paticular, do not call any database functions from
+this subroutine, as the database connection may not be in a defined state. Any
+Perl warnings generated by this subroutine will not be logged in order to avoid
+infinite recursion.
+
 =item log_slow_pages
 
 Setting this to a number will log all pages that took longer to generate than
@@ -455,8 +470,9 @@ Returns the value of the I<debug> setting.
 Writes a message to the log file configured with I<logfile>. When no log file
 is configured, C<log()> will do nothing. The I<message> argument may contain
 newlines, which will be nicely (re-)formatted before logging, in order to avoid
-ambiguity with other log entries. The log message will be prefixed with the
-date and URI of the request.
+ambiguity with other log entries. By default the log message will be prefixed
+with the date and URI of the request, but this can be changed with the
+L<log_format|/log_format> setting.
 
 This function is not used very often in practice, since it is easier to simply
 use Perl's C<warn()> function instead. TUWF automatically writes all warnings