Move caller() parts to Log::Any::Adapter::Util

Signed-off-by: Mikko Koivunalho <mikkoi@cpan.org>
preaction · May 5, 2023 · 11db2de · 11db2de
1 parent 2179a83
commit 11db2de
Show file tree

Hide file tree

Showing 3 changed files with 37 additions and 17 deletions.
diff --git a/lib/Log/Any/Adapter/Util.pm b/lib/Log/Any/Adapter/Util.pm
@@ -180,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

diff --git a/lib/Log/Any/Proxy.pm b/lib/Log/Any/Proxy.pm
@@ -96,12 +96,9 @@ foreach my $name ( Log::Any::Adapter::Util::logging_methods(), keys(%aliases) )
         return if !$self->{adapter}->$is_realname && !defined wantarray;
 
         # Execute hook: build_context
-        my $caller = (caller 0)[0] ne 'Log::Any::Proxy'
-                    && (caller 0)[3] eq 'Log::Any::Proxy::__ANON__'
-                ? [ caller 0 ] : [ caller 1 ];
         my %items;
         foreach my $hook (@{ $self->{hooks}->{build_context} }) {
-            my %i = $hook->( $realname, $self->{category}, $caller, \%items);
+            my %i = $hook->( $realname, $self->{category}, \%items);
             @items{keys %i} = @i{keys %i};
         }
 

diff --git a/t/hooks.t b/t/hooks.t
@@ -4,6 +4,7 @@ use Test::More tests => 1;
 
 use Log::Any::Adapter;
 use Log::Any '$log';
+use Log::Any::Adapter::Util;
 
 use FindBin;
 use lib $FindBin::RealBin;
@@ -12,10 +13,10 @@ use TestAdapters;
 sub create_normal_log_lines {
     my ($log) = @_;
 
-    $log->info('some info');
-    $log->infof( 'more %s', 'info' );
-    $log->infof( 'info %s %s', { with => 'data' }, 'and more text' );
-    $log->debug( "program started",
+    $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" } );
 
 }
@@ -27,7 +28,8 @@ create_normal_log_lines($log);
 pop @{ $log->hooks->{'build_context'} };
 
 sub build_context {
-    my ($lvl, $cat, $caller, $data) = @_;
+    my ($lvl, $cat, $data) = @_;
+    my $caller = Log::Any::Adapter::Util::get_correct_caller();
     my %ctx;
     $ctx{lvl} = $lvl;
     $ctx{cat} = $cat;
@@ -40,44 +42,44 @@ sub build_context {
 is_deeply(
     \@TestAdapters::STRUCTURED_LOG,
     [
-        { messages => ['some info'], level => 'info', category => 'main',
+        { messages => ['(info) some info'], level => 'info', category => 'main',
             data => [ {
-                  'line' => 15,
+                  'line' => 16,
                   'cat' => 'main',
                   'lvl' => 'info',
                   'file' => 't/hooks.t',
                   'n' => 1,
                 }],
         },
-        { messages => ['more info'], level => 'info', category => 'main',
+        { messages => ['(infof) more info'], level => 'info', category => 'main',
             data => [ {
-                  'line' => 16,
+                  'line' => 17,
                   'cat' => 'main',
                   'lvl' => 'info',
                   'file' => 't/hooks.t',
                   'n' => 1,
                 }],
         },
-        { messages => ['info {with => "data"} and more text'],
+        { messages => ['(infof) info {with => "data"} and more text'],
           level    => 'info',
           category => 'main',
           data     => [
               {
-                  'line' => 17,
+                  'line' => 18,
                   'cat' => 'main',
                   'lvl' => 'info',
                   'file' => 't/hooks.t',
                   'n' => 1,
               },
           ],
         },
-        {   messages => ['program started'],
+        {   messages => ['(debug) program started'],
             level    => 'debug',
             category => 'main',
             data     => [
                 {
                     perl_version => "5.20.0", progname => "foo.pl", pid => 1234,
-                  'line' => 18,
+                  'line' => 19,
                   'cat' => 'main',
                   'lvl' => 'debug',
                   'file' => 't/hooks.t',