diff --git a/lib/Log/Any.pm b/lib/Log/Any.pm index cdc1c1b..374b7fd 100644 --- a/lib/Log/Any.pm +++ b/lib/Log/Any.pm @@ -95,9 +95,25 @@ 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::Adapter::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 + %params, adapter => $adapter, category => $category, context => $context, + hooks => $hooks, ); } diff --git a/lib/Log/Any/Adapter/Util.pm b/lib/Log/Any/Adapter/Util.pm index 9c36642..e5d3eaa 100644 --- a/lib/Log/Any/Adapter/Util.pm +++ b/lib/Log/Any/Adapter/Util.pm @@ -36,6 +36,7 @@ our @EXPORT_OK = qw( logging_aliases logging_and_detection_methods logging_methods + hook_names make_method numeric_level read_file @@ -47,7 +48,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, + @hook_names ); BEGIN { %LOG_LEVEL_ALIASES = ( @@ -63,6 +65,8 @@ BEGIN { @detection_methods = map { "is_$_" } @logging_methods; @detection_aliases = map { "is_$_" } @logging_aliases; @logging_and_detection_methods = ( @logging_methods, @detection_methods ); + @hook_names = + qw(build_context); } =sub logging_methods @@ -89,6 +93,14 @@ Returns a list of logging and detection methods (but not aliases). sub logging_and_detection_methods { @logging_and_detection_methods } +=sub hook_names + +Returns a list of hook names. + +=cut + +sub hook_names { @hook_names } + =sub log_level_aliases Returns key/value pairs mapping aliases to "official" names. E.g. "err" maps @@ -168,6 +180,27 @@ sub make_method { *{ $pkg . "::$method" } = $code; } +=sub get_correct_caller + +Return the B information. +Use this sub routine only in a hook! + +Because caller stack is dependent on Log::Any internals +we provide it here. +If you are not using this sub routine from the root of +the hook call, use parameter B to specify the number +of stack layers you have. + +=cut + +sub get_correct_caller { + my ($nr_layers) = $_[0] // 2; + return (caller $nr_layers)[0] ne 'Log::Any::Proxy' + && (caller $nr_layers)[3] eq 'Log::Any::Proxy::__ANON__' + ? [ caller $nr_layers ] + : [ caller $nr_layers + 1 ]; +} + =sub require_dynamic (DEPRECATED) Given a class name, attempts to load it via require unless the class diff --git a/lib/Log/Any/Proxy.pm b/lib/Log/Any/Proxy.pm index ca3376f..59bd05e 100644 --- a/lib/Log/Any/Proxy.pm +++ b/lib/Log/Any/Proxy.pm @@ -55,6 +55,10 @@ sub new { require Carp; Carp::croak("$class requires a 'context' parameter"); } + unless ( $self->{hooks} ) { + require Carp; + Carp::croak("$class requires a 'hooks' parameter"); + } bless $self, $class; $self->init(@_); return $self; @@ -67,7 +71,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} }; } @@ -91,14 +95,23 @@ foreach my $name ( Log::Any::Adapter::Util::logging_methods(), keys(%aliases) ) my ( $self, @parts ) = @_; return if !$self->{adapter}->$is_realname && !defined wantarray; + # Execute hook: build_context + my %items; + foreach my $hook (@{ $self->{hooks}->{build_context} }) { + my %i = $hook->( $realname, $self->{category}, \%items); + @items{keys %i} = @i{keys %i}; + } + my $structured_logging = $self->{adapter}->can('structured') && !$self->{filter}; my $data_from_parts = pop @parts if ( @parts && ( ( ref $parts[-1] || '' ) eq ref {} ) ); my $data_from_context = $self->{context}; + my $data_from_hooks = \%items; my $data = - { map {%$_} grep {$_ && %$_} $data_from_context, $data_from_parts }; + { map {%$_} grep {$_ && %$_} $data_from_context, $data_from_parts, + $data_from_hooks, }; if ($structured_logging) { unshift @parts, $self->{prefix} if $self->{prefix}; diff --git a/t/hooks.t b/t/hooks.t new file mode 100644 index 0000000..f4987b1 --- /dev/null +++ b/t/hooks.t @@ -0,0 +1,92 @@ +use strict; +use warnings; +use Test::More tests => 1; + +use Log::Any::Adapter; +use Log::Any '$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" } ); + +} + +Log::Any::Adapter->set('+TestAdapters::Structured'); + +push @{ $log->hooks->{'build_context'} }, \&build_context; +create_normal_log_lines($log); +pop @{ $log->hooks->{'build_context'} }; + +sub build_context { + my ($lvl, $cat, $data) = @_; + my $caller = Log::Any::Adapter::Util::get_correct_caller(); + my %ctx; + $ctx{lvl} = $lvl; + $ctx{cat} = $cat; + $ctx{file} = $caller->[1]; + $ctx{line} = $caller->[2]; + $ctx{n} = 1; + return %ctx; +} + +is_deeply( + \@TestAdapters::STRUCTURED_LOG, + [ + { messages => ['(info) some info'], level => 'info', category => 'main', + data => [ { + 'line' => 16, + 'cat' => 'main', + 'lvl' => 'info', + 'file' => 't/hooks.t', + 'n' => 1, + }], + }, + { messages => ['(infof) more info'], level => 'info', category => 'main', + data => [ { + 'line' => 17, + 'cat' => 'main', + 'lvl' => 'info', + 'file' => 't/hooks.t', + 'n' => 1, + }], + }, + { messages => ['(infof) info {with => "data"} and more text'], + level => 'info', + category => 'main', + data => [ + { + 'line' => 18, + 'cat' => 'main', + 'lvl' => 'info', + 'file' => 't/hooks.t', + 'n' => 1, + }, + ], + }, + { messages => ['(debug) program started'], + level => 'debug', + category => 'main', + data => [ + { + perl_version => "5.20.0", progname => "foo.pl", pid => 1234, + 'line' => 19, + 'cat' => 'main', + 'lvl' => 'debug', + 'file' => 't/hooks.t', + 'n' => 1, + } + ] + }, + ], + 'identical output of normal log lines when using structured log adapter' + );