diff --git a/lib/Log/Any.pm b/lib/Log/Any.pm index 9d6c955..f2d8202 100644 --- a/lib/Log/Any.pm +++ b/lib/Log/Any.pm @@ -18,6 +18,7 @@ use Log::Any::Adapter::Util qw( logging_and_detection_methods logging_methods ); +use Log::Any::Proxy::Util (); # This is overridden in Log::Any::Test our $OverrideDefaultAdapterClass; @@ -95,10 +96,28 @@ sub get_logger { my $adapter = $class->_manager->get_adapter( $category ); my $context = $class->_manager->get_context(); + my $hooks_params = + defined $params{hooks} ? delete $params{hooks} : {}; + my $hooks = {}; + for my $hook_name (Log::Any::Proxy::Util::hook_names()) { + if( defined $hooks_params->{$hook_name} ) { + if( ref $hooks_params->{$hook_name} ne 'ARRAY' ) { + require Carp; + Carp::croak("Fault in hook definition: not array"); + } + $hooks->{$hook_name} = $hooks_params->{$hook_name}; + } else { + $hooks->{$hook_name} = []; + } + } + require_dynamic($proxy_class); - return $proxy_class->new( - %params, adapter => $adapter, category => $category, context => $context + my $proxy = $proxy_class->new( + %params, adapter => $adapter, category => $category, context => $context, + hooks => $hooks, ); + $adapter->{proxy} = $proxy; + return $proxy; } sub _get_proxy_class { diff --git a/lib/Log/Any/Adapter/Util.pm b/lib/Log/Any/Adapter/Util.pm index 950a2e7..04fb0da 100644 --- a/lib/Log/Any/Adapter/Util.pm +++ b/lib/Log/Any/Adapter/Util.pm @@ -47,7 +47,8 @@ push @EXPORT_OK, keys %LOG_LEVELS; our %EXPORT_TAGS = ( 'levels' => [ keys %LOG_LEVELS ] ); my ( %LOG_LEVEL_ALIASES, @logging_methods, @logging_aliases, @detection_methods, - @detection_aliases, @logging_and_detection_methods ); + @detection_aliases, @logging_and_detection_methods, + ); BEGIN { %LOG_LEVEL_ALIASES = ( diff --git a/lib/Log/Any/Proxy.pm b/lib/Log/Any/Proxy.pm index 34f8bdd..084ebd3 100644 --- a/lib/Log/Any/Proxy.pm +++ b/lib/Log/Any/Proxy.pm @@ -67,7 +67,7 @@ sub clone { sub init { } -for my $attr (qw/adapter category filter formatter prefix context/) { +for my $attr (qw/adapter category filter formatter prefix context hooks/) { no strict 'refs'; *{$attr} = sub { return $_[0]->{$attr} }; } @@ -100,6 +100,24 @@ foreach my $name ( Log::Any::Adapter::Util::logging_methods(), keys(%aliases) ) my $data = { map {%$_} grep {$_ && %$_} $data_from_context, $data_from_parts }; + # Hooks defined when using Log::Any::Proxy + if( defined $self->{hooks} ) { + foreach my $hook (@{ $self->{hooks}->{context} }) { + $hook->( $realname, $self->{category}, $data, + { proxy => $self, calling_sub => $name, } + ); + } + } + + # Hooks defined when using Log::Any::Adapter + my $calling_sub = (caller 0)[0] eq __PACKAGE__ ? $name.q{f} : $name; + if( defined $self->{adapter}->{hooks}->{proxy} ) { + foreach my $hook (@{ $self->{adapter}->{hooks}->{proxy} }) { + $hook->( $realname, $self->{category}, $data, + { proxy => $self, calling_sub => $calling_sub, } + ); + } + } if ($structured_logging) { unshift @parts, $self->{prefix} if $self->{prefix}; $self->{adapter} @@ -135,6 +153,10 @@ foreach my $name ( Log::Any::Adapter::Util::logging_methods(), keys(%aliases) ) 1; +=pod + +=encoding utf8 + =head1 SYNOPSIS # prefix log messages diff --git a/lib/Log/Any/Proxy/Util.pm b/lib/Log/Any/Proxy/Util.pm new file mode 100644 index 0000000..952cf10 --- /dev/null +++ b/lib/Log/Any/Proxy/Util.pm @@ -0,0 +1,33 @@ +use 5.008001; +use strict; +use warnings; + +package Log::Any::Proxy::Util; + +# ABSTRACT: Common utility functions for Log::Any::Proxy objects +our $VERSION = '1.719'; + +use Exporter; +our @ISA = qw/Exporter/; + +our @EXPORT_OK = qw( + hook_names +); + +our %EXPORT_TAGS = ( ); + +my ( @hook_names ); + +BEGIN { + @hook_names = qw( context ); +} + +=sub hook_names + +Returns a list of hook names. + +=cut + +sub hook_names { @hook_names } + +1; diff --git a/t/hooks.t b/t/hooks.t new file mode 100644 index 0000000..02fc607 --- /dev/null +++ b/t/hooks.t @@ -0,0 +1,80 @@ +use strict; +use warnings; +use Test::More tests => 1; + +use Log::Any::Adapter; +use Log::Any qw( $log ); +use Log::Any::Adapter::Util; + +use FindBin; +use lib $FindBin::RealBin; +use TestAdapters; + +sub create_normal_log_lines { + my ($log) = @_; + + $log->info('(info) some info'); + $log->infof( '(infof) more %s', 'info' ); + $log->infof( '(infof) info %s %s', { with => 'data' }, 'and more text' ); + $log->debug( '(debug) program started', + { progname => 'foo.pl', pid => 1234, perl_version => '5.20.0' } ); + return; +} + +Log::Any::Adapter->set('+TestAdapters::Structured'); + +push @{ $log->hooks->{'context'} }, \&build_context; +create_normal_log_lines($log); +pop @{ $log->hooks->{'build_context'} }; + +sub build_context { + my ($lvl, $cat, $data) = @_; + $data->{lvl} = $lvl; + $data->{cat} = $cat; + $data->{n} = 1; + return; +} + +is_deeply( + \@TestAdapters::STRUCTURED_LOG, + [ + { messages => ['(info) some info'], level => 'info', category => 'main', + data => [ { + 'cat' => 'main', + 'lvl' => 'info', + 'n' => 1, + }], + }, + { messages => ['(infof) more info'], level => 'info', category => 'main', + data => [ { + 'cat' => 'main', + 'lvl' => 'info', + 'n' => 1, + }], + }, + { messages => ['(infof) info {with => "data"} and more text'], + level => 'info', + category => 'main', + data => [ + { + 'cat' => 'main', + 'lvl' => 'info', + 'n' => 1, + }, + ], + }, + { messages => ['(debug) program started'], + level => 'debug', + category => 'main', + data => [ + { + perl_version => '5.20.0', progname => 'foo.pl', pid => 1234, + 'cat' => 'main', + 'lvl' => 'debug', + 'n' => 1, + } + ] + }, + ], + 'identical output of normal log lines when using structured log adapter' + );