###########################################
# Test Suite for Composite Appenders
# Mike Schilli, 2004 (m@perlmeister.com)
###########################################
BEGIN {
if($ENV{INTERNAL_DEBUG}) {
require Log::Log4perl::InternalDebug;
Log::Log4perl::InternalDebug->enable();
}
}
use warnings;
use strict;
use Test::More;
BEGIN {
eval {
require Storable;
};
if ($@) {
plan skip_all => "only with Storable"; # Limit.pm needs it and
# early Perl versions dont
# have it.
}else{
plan tests => 20;
}
}
use Log::Log4perl qw(get_logger :levels);
use Log::Log4perl::Level;
use Log::Log4perl::Appender::TestBuffer;
ok(1); # If we made it this far, we/re ok.
##################################################
# Limit Appender
##################################################
# Reset appender population
Log::Log4perl::Appender::TestBuffer->reset();
my $conf = qq(
log4perl.category = WARN, Limiter
# Email appender
log4perl.appender.Buffer = Log::Log4perl::Appender::TestBuffer
log4perl.appender.Buffer.layout = PatternLayout
log4perl.appender.Buffer.layout.ConversionPattern=%d %m %n
# Limiting appender, using the email appender above
log4perl.appender.Limiter = Log::Log4perl::Appender::Limit
log4perl.appender.Limiter.appender = Buffer
log4perl.appender.Limiter.block_period = 3600
);
Log::Log4perl->init(\$conf);
my $logger = get_logger("");
$logger->warn("This message will be sent immediately");
$logger->warn("This message will be delayed by one hour.");
my $buffer = Log::Log4perl::Appender::TestBuffer->by_name("Buffer");
like($buffer->buffer(), qr/immediately/);
unlike($buffer->buffer(), qr/delayed/);
# Now flush the limiter and check again. The delayed message should now
# be there.
my $limit = Log::Log4perl->appenders()->{Limiter};
$limit->flush();
like($buffer->buffer(), qr/immediately/);
like($buffer->buffer(), qr/delayed/);
$buffer->reset();
# Nothing to flush
$limit->flush();
is($buffer->buffer(), "");
##################################################
# Flush method
##################################################
$conf .= <<EOT;
log4perl.appender.Limiter.appender_method_on_flush = clear
EOT
Log::Log4perl->init(\$conf);
$buffer = Log::Log4perl::Appender::TestBuffer->by_name("Buffer");
$logger = get_logger("");
$logger->warn("This message will be queued but discarded on flush.");
$limit = Log::Log4perl->appenders()->{Limiter};
$limit->flush();
is($buffer->buffer(), "");
##################################################
# Limit Appender with max_until_discard
##################################################
# Reset appender population
Log::Log4perl::Appender::TestBuffer->reset();
$conf = qq(
log4perl.category = WARN, Limiter
# Email appender
log4perl.appender.Buffer = Log::Log4perl::Appender::TestBuffer
log4perl.appender.Buffer.layout = PatternLayout
log4perl.appender.Buffer.layout.ConversionPattern=%d %m %n
# Limiting appender, using the email appender above
log4perl.appender.Limiter = Log::Log4perl::Appender::Limit
log4perl.appender.Limiter.appender = Buffer
log4perl.appender.Limiter.block_period = 3600
log4perl.appender.Limiter.max_until_discarded = 1
);
Log::Log4perl->init(\$conf);
$logger = get_logger("");
$logger->warn("This message will be sent immediately");
for(1..10) {
$logger->warn("This message will be discarded");
}
# Artificially flush the limit appender
$limit = Log::Log4perl->appenders()->{Limiter};
$limit->flush();
$buffer = Log::Log4perl::Appender::TestBuffer->by_name("Buffer");
like($buffer->buffer(), qr/immediately/);
unlike($buffer->buffer(), qr/discarded/);
##################################################
# Limit Appender with max_until_discard
##################################################
# Reset appender population
Log::Log4perl::Appender::TestBuffer->reset();
$conf = qq(
log4perl.category = WARN, Limiter
# Email appender
log4perl.appender.Buffer = Log::Log4perl::Appender::TestBuffer
log4perl.appender.Buffer.layout = PatternLayout
log4perl.appender.Buffer.layout.ConversionPattern=%d %m %n
# Limiting appender, using the email appender above
log4perl.appender.Limiter = Log::Log4perl::Appender::Limit
log4perl.appender.Limiter.appender = Buffer
log4perl.appender.Limiter.block_period = 3600
log4perl.appender.Limiter.max_until_discarded = 1
);
Log::Log4perl->init(\$conf);
$logger = get_logger("");
$logger->warn("This message will be sent immediately");
for(1..10) {
$logger->warn("This message will be discarded");
}
# Artificially flush the limit appender
$limit = Log::Log4perl->appenders()->{Limiter};
$limit->flush();
$buffer = Log::Log4perl::Appender::TestBuffer->by_name("Buffer");
like($buffer->buffer(), qr/immediately/);
unlike($buffer->buffer(), qr/discarded/);
##################################################
# Limit Appender with max_until_flushed
##################################################
# Reset appender population
Log::Log4perl::Appender::TestBuffer->reset();
$conf = qq(
log4perl.category = WARN, Limiter
# Email appender
log4perl.appender.Buffer = Log::Log4perl::Appender::TestBuffer
log4perl.appender.Buffer.layout = PatternLayout
log4perl.appender.Buffer.layout.ConversionPattern=%d %m %n
# Limiting appender, using the email appender above
log4perl.appender.Limiter = Log::Log4perl::Appender::Limit
log4perl.appender.Limiter.appender = Buffer
log4perl.appender.Limiter.block_period = 3600
log4perl.appender.Limiter.max_until_flushed = 2
);
Log::Log4perl->init(\$conf);
$logger = get_logger("");
$logger->warn("This message will be sent immediately");
$logger->warn("This message won't show right away");
$buffer = Log::Log4perl::Appender::TestBuffer->by_name("Buffer");
like($buffer->buffer(), qr/immediately/);
unlike($buffer->buffer(), qr/right away/);
$logger->warn("This message will show right away");
like($buffer->buffer(), qr/right away/);
#################################
#demonstrating bug in Limiter.pm regarding $_
# Reset appender population
Log::Log4perl::Appender::TestBuffer->reset();
{package My::Test::Appender;
our @ISA = ('Log::Log4perl::Appender::TestBuffer');
sub new {
my $self = shift;
$_ = ''; #aye, there's the rub!
$self->SUPER::new;
}
}
$conf = qq(
log4perl.category = WARN, Limiter
log4perl.appender.Buffer = My::Test::Appender
log4perl.appender.Buffer.layout = SimpleLayout
log4perl.appender.Buffer.layout.ConversionPattern=%d %m %n
log4perl.appender.Limiter = Log::Log4perl::Appender::Limit
log4perl.appender.Limiter.appender = Buffer
log4perl.appender.Limiter.block_period = 3600
);
Log::Log4perl->init(\$conf);
ok(1);
### API initialization
#
Log::Log4perl->reset();
my $bufApp = Log::Log4perl::Appender->new(
'Log::Log4perl::Appender::TestBuffer',
name => 'MyBuffer',
);
$bufApp->layout(
Log::Log4perl::Layout::PatternLayout::Multiline->new(
'%m%n')
);
# Make the appender known to the system (without assigning it to
# any logger
Log::Log4perl->add_appender( $bufApp );
my $limitApp = Log::Log4perl::Appender->new(
'Log::Log4perl::Appender::Limit',
name => 'MyLimit',
appender => 'MyBuffer',
key => 'nem',
);
$limitApp->post_init();
$limitApp->composite(1);
$buffer = Log::Log4perl::Appender::TestBuffer->by_name("MyBuffer");
get_logger("")->add_appender($limitApp);
get_logger("")->level($DEBUG);
get_logger("wonk")->debug("waah!");
is($buffer->buffer(), "waah!\n", "composite api init");
### Wrong %M with caching appender
#
Log::Log4perl->reset();
Log::Log4perl::Appender::TestBuffer->reset();
$conf = qq(
log4perl.category = WARN, Limiter
# TestBuffer appender
log4perl.appender.Buffer = Log::Log4perl::Appender::TestBuffer
log4perl.appender.Buffer.layout = PatternLayout
log4perl.appender.Buffer.layout.ConversionPattern=%d cat=%c meth=%M %m %n
# Limiting appender, using the email appender above
log4perl.appender.Limiter = Log::Log4perl::Appender::Limit
log4perl.appender.Limiter.appender = Buffer
log4perl.appender.Limiter.block_period = 3600
log4perl.appender.Limiter.max_until_flushed = 2
);
Log::Log4perl->init(\$conf);
$logger = get_logger();
$logger->warn("Sent from main");
package Willy::Wonka;
sub func {
use Log::Log4perl qw(get_logger);
my $logger = get_logger();
$logger->warn("Sent from func");
}
package main;
Willy::Wonka::func();
$logger->warn("Sent from main");
$buffer = Log::Log4perl::Appender::TestBuffer->by_name("Buffer");
like($buffer->buffer(),
qr/cat=main meth=main::.*cat=Willy.Wonka meth=Willy::Wonka::func/s,
"%M/%c with composite appender");
### Different caller stacks with normal vs. composite appenders
Log::Log4perl->reset();
$conf = qq(
log4perl.category = WARN, Buffer1, Composite
# 1st TestBuffer appender
log4perl.appender.Buffer1 = Log::Log4perl::Appender::TestBuffer
log4perl.appender.Buffer1.layout = PatternLayout
log4perl.appender.Buffer1.layout.ConversionPattern=meth=%M %m %n
# 2nd TestBuffer appender
log4perl.appender.Buffer2 = Log::Log4perl::Appender::TestBuffer
log4perl.appender.Buffer2.layout = PatternLayout
log4perl.appender.Buffer2.layout.ConversionPattern=meth=%M %m %n
# Composite Appender
log4perl.appender.Composite = Log::Log4perl::Appender::Buffer
log4perl.appender.Composite.appender = Buffer2
log4perl.appender.Composite.trigger = sub { 1 }
);
Log::Log4perl->init(\$conf);
my $buffer1 = Log::Log4perl::Appender::TestBuffer->by_name("Buffer1");
my $buffer2 = Log::Log4perl::Appender::TestBuffer->by_name("Buffer2");
$logger = get_logger();
$logger->warn("Sent from main");
Willy::Wonka::func();
like $buffer1->buffer(),
qr/meth=main:: Sent from main.*meth=Willy::Wonka::func Sent from func/s,
"caller stack from direct appender";
like $buffer2->buffer(),
qr/meth=main:: Sent from main.*meth=Willy::Wonka::func Sent from func/s,
"caller stack from composite appender";
# [RT 72056] Appender Threshold blocks composite appender
$conf = qq(
log4perl.category = DEBUG, Composite
log4perl.appender.Buffer = Log::Log4perl::Appender::TestBuffer
log4perl.appender.Buffer.layout = PatternLayout
log4perl.appender.Buffer.Threshold=INFO
log4perl.appender.Buffer.layout.ConversionPattern=%M %m %n
# Composite Appender
log4perl.appender.Composite = Log::Log4perl::Appender::Buffer
log4perl.appender.Composite.appender = Buffer
log4perl.appender.Composite.trigger = sub { 0 }
);
Log::Log4perl->init(\$conf);
$buffer = Log::Log4perl::Appender::TestBuffer->by_name("Buffer");
$logger = get_logger();
$logger->debug("this will be blocked by the appender threshold");
my $composite = Log::Log4perl->appender_by_name("Composite");
$composite->flush();
is $buffer->buffer(), "",
"appender threshold blocks message in composite appender";