#!perl
use strict;
# build logger
my $app=Log::Log4perl::Appender->new('Log::Log4perl::Appender::String',
utf8=>1);
my $rlog=Log::Log4perl->get_logger('');
$rlog->level(Log::Log4perl::Level::to_priority 'DEBUG');
$rlog->add_appender($app);
$Log::Log4perl::Logger::INITIALIZED=1;
my $l=Log::Log4perl->get_logger('klaus');
note $l;
sub l1 {$l->debug('msg')} my $l1_line=__LINE__;
sub l2 {l1}
sub l3 {l2}
sub l4 {l3}
sub l5 {l4}
sub l6 {l5}
sub l7 {l6}
sub l8 {l7}
sub l9 {l8}
sub l10 {l9}
delete $ENV{L4P_STACKTRACE};
{
$app->layout(Log::Log4perl::Layout::PatternLayout->new('a%m%S%n'));
l1; my $ln=__LINE__;
my $exp=<<"EOF";
amsg
==== START STACK TRACE ===
[1] at t/100-l4p.t line $l1_line
__ANON__ ($l, "msg")
[2] at t/100-l4p.t line $ln
l1 ()
=== END STACK TRACE ===
EOF
my $res=$app->string;
is $res, $exp, 'default format with L4P_STACKTRACE=undef';
$app->string('');
}
{
local $ENV{L4P_STACKTRACE_MAX}=4;
$app->layout(Log::Log4perl::Layout::PatternLayout->new('a%m%S%n'));
l10; my $ln=__LINE__;
my $exp=<<"EOF";
amsg
==== START STACK TRACE ===
[ 1] at t/100-l4p.t line $l1_line
__ANON__ ($l, "msg")
[ 2] at t/100-l4p.t line @{[$l1_line+1]}
l1 ()
[ 3] at t/100-l4p.t line @{[$l1_line+2]}
l2 ()
[ 4] at t/100-l4p.t line @{[$l1_line+3]}
l3 ()
... 7 frames cut off
=== END STACK TRACE ===
EOF
my $res=$app->string;
is $res, $exp, 'default format with L4P_STACKTRACE_MAX=4';
$app->string('');
}
for my $e (qw/off no 0/) {
local $ENV{L4P_STACKTRACE}=$e;
$app->layout(Log::Log4perl::Layout::PatternLayout->new('a%m%Sb'));
$l->debug('msg');
is $app->string, 'amsgb', 'default format with L4P_STACKTRACE='.$e;
$app->string('');
}
for my $e (qw/on yes 1/) {
local $ENV{L4P_STACKTRACE}=$e;
$app->layout(Log::Log4perl::Layout::PatternLayout->new('a%m%S%n'));
l1; my $ln=__LINE__;
my $exp=<<"EOF";
amsg
==== START STACK TRACE ===
[1] at t/100-l4p.t line $l1_line
__ANON__ ($l, "msg")
[2] at t/100-l4p.t line $ln
l1 ()
=== END STACK TRACE ===
EOF
my $res=$app->string;
is $res, $exp, 'default format with L4P_STACKTRACE='.$e;
$app->string('');
}
{
local $ENV{L4P_STACKTRACE_A}='dump=CODE, deparse, multiline=12';
$app->layout(Log::Log4perl::Layout::PatternLayout->new('a%m%S%n'));
l1 sub {1+1}; my $ln=__LINE__;
my $sub_deparsed = Data::Dumper->new([sub{2}])->Useqq(1)->Terse(1)
->Deparse(1)->Indent(0)->Dump;
my $exp=<<"EOF";
amsg
==== START STACK TRACE ===
[1] at t/100-l4p.t line $l1_line
__ANON__ (
$l,
"msg"
)
[2] at t/100-l4p.t line $ln
l1 (
$sub_deparsed
)
=== END STACK TRACE ===
EOF
my $res=$app->string;
is $res, $exp, 'default format with L4P_STACKTRACE_A="dump=CODE, deparse, multiline"';
$app->string('');
}
{
$app->layout(Log::Log4perl::Layout::PatternLayout->new
('a%m%S{%[nr=1,n]b [%n] %[basename]f (%l)}%n'));
l2; my $ln=__LINE__;
my $exp=<<"EOF";
amsg
[1] 100-l4p.t ($l1_line)
[2] 100-l4p.t (@{[$l1_line+1]})
[3] 100-l4p.t ($ln)
EOF
my $res=$app->string;
is $res, $exp, 'format in curlies';
$app->string('');
}
{
local $ENV{ENVVAR}='%[nr=1,n]b {%n} %[basename]f (%l)';
$app->layout(Log::Log4perl::Layout::PatternLayout->new
('a%m%S{env=ENVVAR}%n'));
l2; my $ln=__LINE__;
my $exp=<<"EOF";
amsg
{1} 100-l4p.t ($l1_line)
{2} 100-l4p.t (@{[$l1_line+1]})
{3} 100-l4p.t ($ln)
EOF
my $res=$app->string;
is $res, $exp, 'format read from ENVVAR';
$app->string('');
}
done_testing;