Add support for hooks

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,
     );
 }
 

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<caller(num)> 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<num> 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

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};

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'
+    );