Subject: | Wrong caller depth in Log::Report::Dispatcher::Log4perl |
Log::Report used with L:R:Dispatcher::Log4perl is showing wrong file name and line number where log
statement is issued:
Show quoted text
> $ cat log-report.pl
> #!/usr/bin/perl
>
> use Log::Report;
> use Log::Report::Dispatcher::Log4perl;
>
>
> my $name = 'logger';
> dispatcher 'Log::Log4perl' => $name, mode => 'DEBUG', config => {
> "log4perl.logger.$name" => "DEBUG, Screen",
> "log4perl.appender.Screen" => "Log::Log4perl::Appender::Screen",
> "log4perl.appender.Screen.layout" => "Log::Log4perl::Layout::PatternLayout",
> "log4perl.appender.Screen.layout.ConversionPattern" => "%d %F{2} %L> %m",
> };
>
> dispatcher close => 'default';
>
> #local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + 3;
>
> sub test {
> alert "alert!";
> assert "assert!";
> #error "error!";
> #failure "failure!";
> #fault "fault!";
> info "info!";
> mistake "mistake!";
> notice "notice!";
> #panic "panic!";
> trace "trace!";
> warning "warning!";
> }
>
> test();
Show quoted text> $ perl log-report.pl
> 2013/03/02 23:37:39 Dispatcher/Log4perl.pm 86> alert: alert!;
> at log-report.pl line 24
> main::test() at log-report.pl line 37
> 2013/03/02 23:37:39 Dispatcher/Log4perl.pm 86> assert: assert!
> at log-report.pl line 25
> 2013/03/02 23:37:39 Dispatcher/Log4perl.pm 86> info: info!
> 2013/03/02 23:37:39 Dispatcher/Log4perl.pm 86> mistake: mistake!
> at log-report.pl line 30
> 2013/03/02 23:37:39 Dispatcher/Log4perl.pm 86> notice: notice!
> 2013/03/02 23:37:39 Dispatcher/Log4perl.pm 86> trace: trace!
> 2013/03/02 23:37:39 Dispatcher/Log4perl.pm 86> warning: warning!
Log message should looks like that:
Show quoted text> $ perl log-report.pl
> 2013/03/02 23:38:38 log-report.pl 24> alert: alert!;
> at log-report.pl line 24
> main::test() at log-report.pl line 37
> 2013/03/02 23:38:38 log-report.pl 25> assert: assert!
> at log-report.pl line 25
> 2013/03/02 23:38:38 log-report.pl 29> info: info!
> 2013/03/02 23:38:38 log-report.pl 30> mistake: mistake!
> at log-report.pl line 30
> 2013/03/02 23:38:38 log-report.pl 31> notice: notice!
> 2013/03/02 23:38:38 log-report.pl 33> trace: trace!
> 2013/03/02 23:38:38 log-report.pl 34> warning: warning!
Bugfix on https://github.com/dione/log-report/commit/a5291f343728d73cbf874d70863154a8d60e6527 and in
the appendix
Subject: | caller-depth.patch |
diff --git a/lib/Log/Report/Dispatcher/Log4perl.pm b/lib/Log/Report/Dispatcher/Log4perl.pm
index b85c1bf..a4c1b05 100644
--- a/lib/Log/Report/Dispatcher/Log4perl.pm
+++ b/lib/Log/Report/Dispatcher/Log4perl.pm
@@ -83,6 +83,8 @@ sub log($$$$)
my $text = $self->SUPER::translate(@_) or return;
my $level = $self->reasonToLevel($_[1]);
+ local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + 3;
+
$self->appender->log($level, $text);
$self;
}
diff --git a/t/53log4perl.t b/t/53log4perl.t
index 827b429..5ee6e7c 100644
--- a/t/53log4perl.t
+++ b/t/53log4perl.t
@@ -19,7 +19,7 @@ BEGIN
plan skip_all => "Log::Log4perl too old (is $sv, requires 1.00)"
if $@;
- plan tests => 3;
+ plan tests => 5;
}
my ($out, $outfn) = tempfile;
@@ -31,7 +31,7 @@ log4perl.category.$name = INFO, Logfile
log4perl.appender.Logfile = Log::Log4perl::Appender::File
log4perl.appender.Logfile.filename = $outfn
log4perl.appender.Logfile.layout = Log::Log4perl::Layout::PatternLayout
-log4perl.appender.Logfile.layout.ConversionPattern = %d %F{1} %L> %m
+log4perl.appender.Logfile.layout.ConversionPattern = %d %F{2} %L> %m
__CONFIG
dispatcher 'Log::Log4perl' => $name, config => \$conf
@@ -40,12 +40,23 @@ dispatcher 'Log::Log4perl' => $name, config => \$conf
dispatcher close => 'default';
cmp_ok(-s $outfn, '==', 0);
-notice "this is a test";
+
+my $date_qr = qr!\d{4}/\d{2}/\d{2} \d{2}:\d{2}:\d{2}!;
+my ($line_number, $log_line, $expected_msg);
+
+notice "this is a test"; $line_number = __LINE__;
+
my $s1 = -s $outfn;
cmp_ok($s1, '>', 0);
+$log_line = <$out>;
+$expected_msg = " $0 $line_number> notice: this is a test";
+like($log_line, qr/^$date_qr\Q$expected_msg\E$/);
-warning "some more";
+warning "some more"; $line_number = __LINE__;
my $s2 = -s $outfn;
cmp_ok($s2, '>', $s1);
+$log_line = do { <$out> };
+$expected_msg = " $0 $line_number> warning: some more";
+like($log_line, qr/^$date_qr\Q$expected_msg\E$/);
unlink $outfn;