diff --git a/cpanfile b/cpanfile index 8d55562a2..70e62e99e 100644 --- a/cpanfile +++ b/cpanfile @@ -77,6 +77,7 @@ recommends 'Type::Tiny::XS'; recommends 'URL::Encode::XS'; recommends 'YAML::XS'; recommends 'Unicode::UTF8'; +recommends 'Log::Any'; suggests 'Fcntl'; suggests 'MIME::Types'; @@ -92,6 +93,7 @@ test_requires 'Test::Fatal'; test_requires 'Test::More'; test_requires 'Test::More', '0.92'; test_requires 'Test::Exception'; +test_requires 'Log::Any'; author_requires 'Test::NoTabs'; author_requires 'Test::Pod'; diff --git a/lib/Dancer2/Core/Role/Logger.pm b/lib/Dancer2/Core/Role/Logger.pm index b260f42ab..bf8cab6fa 100644 --- a/lib/Dancer2/Core/Role/Logger.pm +++ b/lib/Dancer2/Core/Role/Logger.pm @@ -43,6 +43,12 @@ has log_format => ( default => sub {'[%a:%P] %L @%T> %m in %f l. %l'}, ); +has caller_stack_size => ( + is => 'rw', + isa => Int, + default => sub { 9; }, +); + my $_levels = { # levels < 0 are for core only @@ -75,7 +81,6 @@ sub format_message { $message = Encode::encode( $self->auto_encoding_charset, $message ) if $self->auto_encoding_charset; - my @stack = caller(8); my $request = $self->request; my $config = $self->config; @@ -93,22 +98,7 @@ sub format_message { } }; - my $chars_mapping = { - a => sub { $self->app_name }, - t => sub { POSIX::strftime( "%d/%b/%Y %H:%M:%S", localtime(time) ) }, - T => sub { POSIX::strftime( "%Y-%m-%d %H:%M:%S", localtime(time) ) }, - u => sub { POSIX::strftime( "%d/%b/%Y %H:%M:%S", gmtime(time) ) }, - U => sub { POSIX::strftime( "%Y-%m-%d %H:%M:%S", gmtime(time) ) }, - P => sub {$$}, - L => sub {$level}, - m => sub {$message}, - f => sub { $stack[1] || '-' }, - l => sub { $stack[2] || '-' }, - h => sub { - ( $request && ( $request->remote_host || $request->address ) ) || '-' - }, - i => sub { ( $request && $request->id ) || '-' }, - }; + my $chars_mapping = $self->map_chars_to_subs($level, $message, ); my $char_mapping = sub { my $char = shift; @@ -133,6 +123,29 @@ sub format_message { return $fmt . "\n"; } +sub map_chars_to_subs { + my ( $self, $level, $message, $caller_delta ) = @_; + my @stack = caller($self->caller_stack_size + ($caller_delta // 0)); + my $request = $self->request; + return { + a => sub { $self->app_name }, + t => sub { POSIX::strftime( "%d/%b/%Y %H:%M:%S", localtime(time) ) }, + T => sub { POSIX::strftime( "%Y-%m-%d %H:%M:%S", localtime(time) ) }, + u => sub { POSIX::strftime( "%d/%b/%Y %H:%M:%S", gmtime(time) ) }, + U => sub { POSIX::strftime( "%Y-%m-%d %H:%M:%S", gmtime(time) ) }, + P => sub {$$}, + L => sub {$level}, + m => sub {$message}, + p => sub { $stack[0] || '-' }, # package + f => sub { $stack[1] || '-' }, # filepath + l => sub { $stack[2] || '-' }, # line number + h => sub { + ( $request && ( $request->remote_host || $request->address ) ) || '-' + }, + i => sub { ( $request && $request->id ) || '-' }, + }; +}; + sub _serialize { my @vars = @_; @@ -226,6 +239,10 @@ Log messages as B. Provides a common message formatting. +=method map_chars_to_subs + +Returns a hashref which has all the items needed for message formatting. + =attr auto_encoding_charset Charset to use when writing a message. @@ -282,6 +299,10 @@ timer message +=item %p + +package name that emit the message + =item %f file name that emit the message diff --git a/lib/Dancer2/Logger/Log/Any.pm b/lib/Dancer2/Logger/Log/Any.pm new file mode 100644 index 000000000..0f7511692 --- /dev/null +++ b/lib/Dancer2/Logger/Log/Any.pm @@ -0,0 +1,119 @@ +package Dancer2::Logger::Log::Any; +# ABSTRACT: Log::Any logger with support for structured logging + +use Moo; + +with 'Dancer2::Core::Role::Logger'; + +use Dancer2::Core::Types qw/ Str InstanceOf /; + +has category => ( + is => 'ro', + isa => Str +); +has _logger => ( + is => 'ro', + lazy => 1, + isa => InstanceOf[ 'Log::Any::Proxy' ], + required => 1, + default => sub { + my ($self) = @_; + my %category = $self->category ? ( category => $self->category ) : (); + { + local $@ = undef; + eval { use Log::Any; 1; }; + if( $@ ) { + warn 'Failed to use Log::Any. Have you installed it?'; + } + } + return Log::Any->get_logger( %category ); + }, +); +sub log { + my ( $self, $level, $message, $data ) = @_; + $level = 'trace' if $level eq 'core'; + $data = \(%{ $message }, %{ $data }), $message = q{} if( ref $message ); + my $map = $self->map_chars_to_subs($level, $message, -1); + my %info = ( + app_name => $map->{a}->(), + package => $map->{p}->(), + file => $map->{f}->(), + line => $map->{l}->(), + remote => $map->{h}->(), + request_id => $map->{i}->(), + ); + $data->{ $_ } = $info{ $_ } foreach (keys %info); + $self->_logger->$level( $message ne q{} ? $message : (), $data ); +} + +# Create logging methods: core, debug, info, warning and error. +# +foreach my $level ( qw( core debug info warning error ) ) { + no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitNoStrict) + no warnings 'redefine'; ## no critic (TestingAndDebugging::ProhibitNoWarnings) + *$level = sub { + my ( $self, @args ) = @_; + if( ref $args[-1] eq 'HASH' ) { + $self->_should($level) and $self->log( $level, _serialize(@args[0..($#args-1)]), $args[-1] ); + } else { + $self->_should($level) and $self->log( $level, _serialize(@args) ); + } + }; +} + +1; + +__END__ + +=head1 DESCRIPTION + +This is a logging engine that allows you to print logging messages +to any L. It supports +L. + +=head USAGE + +See CONFIGURATION. + +You also need to configure a L. You can do this in your +F or in any package you read in (C): + + use Log::Any::Adapter; + Log::Any::Adapter->set('Stdout'); + +=head1 CONFIGURATION + +The setting C should be set to C in order to use this logging +engine in a Dancer2 application. + +In your Dancer2 config: + + logger: 'Log::Any' + engines: + logger: + 'Log::Any': + category: app-api + +If you omit the category setting, C will use the name of +this class as the category. + +=head1 METHODS + +=method log + +Writes the log messages to any or all Ls. + +=method core debug info warning error + +Use these in Dancer2 to log to the wanted level. + +=head1 CAVEAT + +This package requires L installed. +It uses it lazily, loading it only at the point when it is needed. + +=head1 SEE ALSO + +L + +C, C diff --git a/t/logger_log_any.t b/t/logger_log_any.t new file mode 100644 index 000000000..8dc81d13f --- /dev/null +++ b/t/logger_log_any.t @@ -0,0 +1,124 @@ +use Test::More; +use strict; +use warnings; + +subtest 'logger Log::Any' => sub { + use Dancer2; + use File::Temp qw/tempdir/; + my $dir = tempdir( CLEANUP => 1 ); + + set engines => { + logger => { + 'Log::Any' => { + category => 'app-web', + } + } + }; + set logger => 'Log::Any'; + my $logfile = File::Spec->catfile($dir, 'test'); + use Log::Any::Adapter; + Log::Any::Adapter->set('File', $logfile); + + my $str = "Logging through Log::Any::Adapter::File"; + info $str; + + open my $log_file, '<', $logfile; + my $txt = <$log_file>; + + like( $txt, qr/^\[[^\]]+\] $str/, 'Logged string matches'); + my ($hash) = $txt =~ m/^\[[^\]]+\] $str (\{.*\})$/; + my $h = eval "$hash "; ## no critic (BuiltinFunctions::ProhibitStringyEval) + is_deeply $h, { + app_name => "main", + file => __FILE__, + line => 23, + package => "main", + remote => "-", + request_id => "-" + }, 'Info structure matches'; + + done_testing; +}; + +subtest 'logger Log::Any with context' => sub { + use Dancer2; + use File::Temp qw/tempdir/; + my $dir = tempdir( CLEANUP => 1 ); + + set engines => { + logger => { + 'Log::Any' => { + category => 'app-web', + } + } + }; + set logger => 'Log::Any'; + my $logfile = File::Spec->catfile($dir, 'test'); + use Log::Any::Adapter; + Log::Any::Adapter->set('File', $logfile); + + my $str = "Logging also context through Log::Any::Adapter::File"; + info $str, { seq => 1, trx => 0, critical => 'Yes' }; + + open my $log_file, '<', $logfile; + my $txt = <$log_file>; + + like( $txt, qr/^\[[^\]]+\] $str/, 'Logged string matches'); + my ($hash) = $txt =~ m/^\[[^\]]+\] $str (\{.*\})$/; + my $h = eval "$hash "; ## no critic (BuiltinFunctions::ProhibitStringyEval) + is_deeply $h, { + app_name => "main", + file => __FILE__, + line => 61, + package => "main", + remote => "-", + request_id => "-", + seq => 1, + trx => 0, + critical => 'Yes', + }, 'Info structure matches'; + + done_testing; +}; + +subtest 'logger Log::Any with complex message and context' => sub { + use Dancer2; + use File::Temp qw/tempdir/; + my $dir = tempdir( CLEANUP => 1 ); + + set engines => { + logger => { + 'Log::Any' => { + category => 'app-web', + } + } + }; + set logger => 'Log::Any'; + my $logfile = File::Spec->catfile($dir, 'test'); + use Log::Any::Adapter; + Log::Any::Adapter->set('File', $logfile); + + my $str = "Logging also context through Log::Any::Adapter::File"; + info $str, 'more', 'parts', { seq => 2, critical => 'No' }; + + open my $log_file, '<', $logfile; + my $txt = <$log_file>; + + like( $txt, qr/^\[[^\]]+\] ${str}moreparts/, 'Logged string matches'); + my ($hash) = $txt =~ m/^\[[^\]]+\] ${str}moreparts (\{.*\})$/; + my $h = eval "$hash "; ## no critic (BuiltinFunctions::ProhibitStringyEval) + is_deeply $h, { + app_name => "main", + file => __FILE__, + line => 102, + package => "main", + remote => "-", + request_id => "-", + seq => 2, + critical => 'No', + }, 'Info structure matches'; + + done_testing; +}; + +done_testing;