Add support for hooks

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 {

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 = (

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

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;

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