use warnings;
use strict;
use Test::More;
use Log::Log4perl qw(get_logger :easy);
use Log::Log4perl::Level;
use File::Spec; use Data::Dumper;
BEGIN {
if ($] < 5.006) {
plan skip_all => "Only with perl >= 5.006";
} else {
plan tests => 62;
}
}
my $warnstr;
local $SIG{__WARN__} = sub { $warnstr = join("", @_); };
local $SIG{__DIE__} = sub { $warnstr = join("", @_); };
sub warndietest {
my ($method, $in_str, $out_str, $app, $mname) = @_;
eval { &$method($in_str) };
like($warnstr, qr/$out_str/,
"$mname($in_str): STDERR contains \"$out_str\"");
like($app->buffer(), qr/$out_str/,
"$mname($in_str): Buffer contains \"$out_str\"");
$app->buffer("");
}
sub warndietest_nooutput {
my ($method, $in_str, $out_str, $app, $mname) = @_;
eval { &$method($in_str) };
unlike($warnstr, qr/$out_str/,
"$mname($in_str): STDERR does NOT contain \"$out_str\"");
unlike($app->buffer(), qr/$out_str/,
"$mname($in_str): Buffer does NOT contain \"$out_str\"");
}
sub dietest_nooutput {
my ($method, $in_str, $out_str, $app, $mname) = @_;
eval { &$method($in_str) };
like($warnstr, qr/$out_str/, "$mname($in_str): STDERR contains \"$out_str\"");
unlike($app->buffer(), qr/$out_str/,
"$mname($in_str): Buffer does NOT contain \"$out_str\"");
}
ok(1, "Initialized OK");
my $log = Log::Log4perl::get_logger("abc.def");
my $app = Log::Log4perl::Appender->new(
"Log::Log4perl::Appender::TestBuffer");
$log->add_appender($app);
$log->level($DEBUG);
my $test = 1;
foreach my $f ("logwarn", "logdie", "logcarp", "logcroak", "logcluck",
"logconfess", "error_warn", "error_die") {
warndietest(sub {$log->$f(@_)}, "Test $test: $f", "Test $test: $f", $app, "$f");
$test++;
}
$log->level($ERROR);
foreach my $f ("logdie", "logcroak",
"logconfess", "error_warn", "error_die") {
warndietest(sub {$log->$f(@_)}, "Test $test: $f", "Test $test: $f", $app, "$f");
$test++;
}
foreach my $f ("logwarn", "logcarp", "logcluck",
) {
warndietest_nooutput(sub {$log->$f(@_)}, "Test $test: $f", "Test $test: $f", $app, "$f");
$test++;
}
$log->level($OFF);
foreach my $f ("logwarn", "logcarp", "logcluck", "error_warn") {
warndietest_nooutput(sub {$log->$f(@_)}, "Test $test: $f", "Test $test: $f", $app, "$f");
$test++;
}
foreach my $f ("error_die", "logdie", "logcroak", "logconfess") {
dietest_nooutput(sub {$log->$f(@_)}, "Test $test: $f", "Test $test: $f", $app, "$f");
$test++;
}
Log::Log4perl->init(\<<'EOT');
log4perl.rootLogger=DEBUG, A1
log4perl.appender.A1=Log::Log4perl::Appender::TestBuffer
log4perl.appender.A1.layout=org.apache.log4j.PatternLayout
log4perl.appender.A1.layout.ConversionPattern=%F-%L: %m
EOT
my $logger = get_logger("Twix::Bar");
eval { $logger->logdie("Log and die!"); };
my $app0 = Log::Log4perl::Appender::TestBuffer->by_name("A1");
like($app0->buffer(), qr/024WarnDieCarp.t-145: Log and die!/,
"%F-%L adjustment");
$app0->buffer("");
package Weirdo;
use Log::Log4perl qw(get_logger);
sub foo {
my $logger = get_logger("Twix::Bar");
$logger->logcroak("Inferno!");
}
sub bar {
my $logger = get_logger("Twix::Bar");
$logger->logdie("Inferno!");
}
package main;
eval { Weirdo::foo(); };
like($app0->buffer(), qr/171/,
"Check logcroak/Carp");
$app0->buffer("");
eval { Weirdo::bar(); };
like($app0->buffer(), qr/167/,
"Check logdie");
$app0->buffer("");
package Foo;
use Log::Log4perl qw(get_logger);
sub foo {
my $logger = get_logger("Twix::Bar");
$logger->logcarp("Inferno!");
}
package Bar;
sub bar {
Foo::foo();
}
package main;
eval { Bar::bar(); };
SKIP: {
use Carp;
skip "Detected buggy Carp.pm (upgrade to perl-5.8.*)", 1 unless
defined $Carp::VERSION;
like($app0->buffer(), qr/197/,
"Check logcarp");
}
$logger = get_logger("Twix::Bar");
$log->level($DEBUG);
eval { $logger->logdie(sub { "a" . "-" . "b" }); };
like($@, qr/a-b/, "bugfix: logdie with sub{} as argument");
$logger->logwarn(sub { "a" . "-" . "b" });
like($warnstr, qr/a-b/, "bugfix: logwarn with sub{} as argument");
$logger->logwarn({ filter => \&Dumper,
value => "a-b" });
like($warnstr, qr/a-b/, "bugfix: logwarn with sub{filter/value} as argument");
eval { $logger->logcroak({ filter => \&Dumper,
value => "a-b" }); };
like($warnstr, qr/a-b/, "bugfix: logcroak with sub{} as argument");
our($carp_line, $call_line);
package Foo1;
use Log::Log4perl qw(:easy);
sub foo { get_logger("Twix::Bar")->logcarp("foocarp"); $carp_line = __LINE__ }
package Bar1;
sub bar { Foo1::foo(); $call_line = __LINE__; }
package main;
my $l4p_app = $Log::Log4perl::Logger::APPENDER_BY_NAME{"A1"};
my $layout = Log::Log4perl::Layout::PatternLayout->new("%M#%L %m%n");
$l4p_app->layout($layout);
$app0->buffer("");
Foo1::foo(); $call_line = __LINE__;
like($app0->buffer(), qr/Foo1::foo "carp in subfunction");
like($warnstr, qr/foocarp.*line $call_line/, "carp output");
$app0->buffer("");
Bar1::bar();
SKIP: {
use Carp;
skip "Detected buggy Carp.pm (upgrade to perl-5.8.*)", 1 unless
defined $Carp::VERSION;
like($app0->buffer(), qr/Foo1::foo "carp in sub-sub-function");
}
like($warnstr, qr/foocarp.*line $call_line/, "carp output");
$app0->buffer("");
package Foo1;
sub new {
my($class) = @_;
bless {}, $class;
}
sub foo1 {
my $log = get_logger();
$log->logconfess("bah!");
}
package main;
my $foo = Foo1->new();
eval { $foo->foo1() };
like $@, qr/024WarnDieCarp.*Foo1::foo1.*eval/s, "Confess logs correct frame";