Merge branch 'topic/logger_strformat' into devel

* topic/logger_strformat:
  typo in POD
  new tests
  add new configuration options:
  remove format 'with_id'; add %i to simple;
  it's now possible to define a custom log format

lib/Dancer/Logger/Abstract.pm

@@ -8,6 +8,7 @@ use base 'Dancer::Engine';
 use Dancer::SharedData;
 use Dancer::Timer;
 use Dancer::Config 'setting';
+use POSIX qw/strftime/;
 
 # This is the only method to implement if logger engines.
 # It receives the following arguments:
@@ -27,6 +28,22 @@ my $levels = {
     error   => 3,
 };
 
+my $log_formats = {
+    simple  => '[%P] %L @%D> %i%m in %f l. %l',
+};
+
+sub _log_format {
+    my $config = setting('logger_format');
+
+    if ( !$config ) {
+        return $log_formats->{simple};
+    }
+
+    exists $log_formats->{$config}
+      ? return $log_formats->{$config}
+      : return $config;
+}
+
 sub _should {
     my ($self, $msg_level) = @_;
     my $conf_level = setting('log') || 'debug';
@@ -49,23 +66,66 @@ sub format_message {
 
     $level = 'warn' if $level eq 'warning';
     $level = sprintf('%5s', $level);
-
-    my ($package, $file, $line) = caller(3);
-    $package ||= '-';
-    $file    ||= '-';
-    $line    ||= '-';
-
-    my $time = Dancer::SharedData->timer->tick;
-    my $r    = Dancer::SharedData->request;
-    if (defined $r) {
-        return
-            "[$$] $level \@$time> [hit #"
-          . $r->id
-          . "] $message in $file l. $line\n";
-    }
-    else {
-        return "[$$] $level \@$time> $message in $file l. $line\n";
-    }
+
+    my $r     = Dancer::SharedData->request;
+    my @stack = caller(3);
+
+    my $block_handler = sub {
+        my ( $block, $type ) = @_;
+        if ( $type eq 't' ) {
+            return "[" . strftime( $block, localtime ) . "]";
+        }
+        elsif ( $type eq 'h' ) {
+            return scalar $r->header($block) || '-';
+        }
+        else {
+            Carp::carp("{$block}$type not supported");
+            return "-";
+        }
+    };
+
+    my $chars_mapping = {
+        h => sub {
+            defined $r
+              ? $r->env->{'HTTP_X_REAL_IP'} || $r->env->{'REMOTE_ADDR'}
+              : '-';
+        },
+        t => sub { POSIX::strftime( "%d/%b/%Y %H:%M:%S", localtime ) },
+        P => sub { $$ },
+        L => sub { $level },
+        D => sub {
+            my $time = Dancer::SharedData->timer->tick;
+            return $time;
+        },
+        m => sub { $message },
+        f => sub { $stack[1] || '-' },
+        l => sub { $stack[2] || '-' },
+        i => sub {
+            defined $r ? "[hit #" . $r->id . "]" : "";
+        },
+    };
+
+    my $char_mapping = sub {
+        my $char = shift;
+
+        my $cb = $chars_mapping->{$char};
+        unless ($cb) {
+            Carp::carp "\%$char not supported.";
+            return "-";
+        }
+        $cb->($char);
+    };
+
+    my $fmt = $self->_log_format();
+
+    $fmt =~ s{
+        (?:
+            \%\{(.+?)\}([a-z])|
+            \%([a-zA-Z])
+        )
+    }{ $1 ? $block_handler->($1, $2) : $char_mapping->($3) }egx;
+
+    return $fmt."\n";
 }
 
 sub core    { $_[0]->_should('core')    and $_[0]->_log('core',    $_[1]) }
@@ -83,11 +143,91 @@ Dancer::Logger::Abstract - Abstract logging engine for Dancer
 
 =head1 SYNOPSIS
 
+In your configuration file:
+
+    # default
+    logger_format: simple
+    # [1234] debug @0.12> [hit #123]message from your log in File.pm line 12
+
+    # custom
+    logger_format: %m %{%H:%M}t [%{accept_type}h]
+    # message from your log [11:59] [text/html]
+
 =head1 DESCRIPTION
 
 This is an abstract logging engine that provides loggers with basic
 functionality and some sanity checking.
 
+=head1 CONFIGURATION
+
+=head2 logger_format
+
+This is a format string (or a preset name) to specify the log format.
+
+The possible values are:
+
+=over 4
+
+=item %h
+
+host emiting the request
+
+=item %t
+
+date (formated like %d/%b/%Y %H:%M:%S)
+
+=item %P
+
+PID
+
+=item %L
+
+log level
+
+=item %D
+
+timer
+
+=item %m
+
+message
+
+=item %f
+
+file name that emit the message
+
+=item %l
+
+line from the file
+
+=item %i
+
+request ID
+
+=item %{$fmt}t
+
+timer formatted with a valid time format
+
+=item %{header}h
+
+header value
+
+=back
+
+There is two preset possible:
+
+=over 4
+
+=item simple
+
+will format the message like: [%P] %L @%D> %m in %f l. %l
+
+=item with_id
+
+will format the message like: [%P] %L @%D> [hit #%i] %m in %f l. %l
+
+=back
+
 =head1 METHODS
 
 =head2 format_message

t/11_logger/05_format.t

@@ -0,0 +1,56 @@
+use strict;
+use warnings;
+use Test::More;
+use Dancer::Config qw/setting/;
+use Dancer::Logger::File;
+use Dancer::Request;
+
+plan tests => 7;
+
+setting logger_format => '(%L) %m';
+my $l = Dancer::Logger::File->new;
+ok my $str = $l->format_message( 'debug', 'this is debug' );
+is $str, "(debug) this is debug\n";
+
+# custom format
+my $fmt = $l->_log_format();
+is $fmt, '(%L) %m';
+
+# no log format defined
+setting logger_format => undef;
+$fmt = $l->_log_format();
+is $fmt, '[%P] %L @%D> %i%m in %f l. %l';
+
+# log format from preset
+setting logger_format => 'simple';
+$fmt = $l->_log_format();
+is $fmt, '[%P] %L @%D> %i%m in %f l. %l';
+
+setting logger_format => '%m %{%H:%M}t';
+$str = $l->format_message('debug', 'this is debug');
+like $str, qr/this is debug \[\d\d:\d\d\]/;
+
+my $env = {
+    'psgi.url_scheme' => 'http',
+    REQUEST_METHOD    => 'GET',
+    SCRIPT_NAME       => '/foo',
+    PATH_INFO         => '/bar/baz',
+    REQUEST_URI       => '/foo/bar/baz',
+    QUERY_STRING      => '',
+    SERVER_NAME       => 'localhost',
+    SERVER_PORT       => 5000,
+    SERVER_PROTOCOL   => 'HTTP/1.1',
+    HTTP_ACCEPT_TYPE  => 'text/html',
+};
+
+my $headers = HTTP::Headers->new();
+$headers->header('Accept-Type' => 'text/html');
+
+my $request = Dancer::Request->new($env);
+$request->{headers} = $headers;
+
+Dancer::SharedData->request($request);
+
+setting logger_format => '[%{accept_type}h] %m';
+$str = $l->format_message('debug', 'this is debug');
+like $str, qr/\[text\/html\] this is debug/;