045Composite.t   [plain text]

###########################################
# Test Suite for Composite Appenders
# Mike Schilli, 2004 (m@perlmeister.com)
###########################################

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 => 14;
    }
}

use Log::Log4perl qw(get_logger);
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(), "");

##################################################
# 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);