view release on metacpan or  search on metacpan

t/02-store.t  view on Meta::CPAN

#! perl -T
use Test::More;

package MyStore;
use Moose;
extends qw/Log::Log4perl::Appender::Chunk::Store/;

has 'messages' => ( is => 'ro', isa => 'HashRef', default => sub{ {}; } );

sub store{
    my ($self, $chunk_id, $big_message) = @_;
    $self->messages()->{$chunk_id} = $big_message;
}
1;

package main;
use Log::Log4perl;

my $conf = q|
log4perl.rootLogger=TRACE, Chunk

layout_class=Log::Log4perl::Layout::PatternLayout
layout_pattern=%m%n

log4perl.appender.Chunk=Log::Log4perl::Appender::Chunk
log4perl.appender.Chunk.store_class=+MyStore
log4perl.appender.Chunk.layout=${layout_class}
log4perl.appender.Chunk.layout.ConversionPattern=${layout_pattern}
|;

Log::Log4perl::init(\$conf);

ok( my $ca =  Log::Log4perl->appender_by_name('Chunk') , "Ok got Chunk appender");
ok( my $store = $ca->store() , "Ok got store for the logger");

my $LOGGER = Log::Log4perl->get_logger();

$LOGGER->info("Something outside any context");

## Chunk 12345
Log::Log4perl::MDC->put('chunk', '12345');

$LOGGER->trace("Some trace inside the chunk");
$LOGGER->debug("Some debug inside the chunk");

$LOGGER->info("Some info inside the chunk");

Log::Log4perl::MDC->put('chunk', undef);
## End of Chunk 12345

$LOGGER->info("Outside context again");

## Chunk 0001
Log::Log4perl::MDC->put('chunk', '0001');
$LOGGER->info("Inside chunk 0001");
$LOGGER->info("Inside chunk 0001 again");


Log::Log4perl::MDC->put('chunk' , '0002' );
## End of Chunk 0001, start chunk 0002
$LOGGER->info("Inside a brand new chunk 0002");
$LOGGER->info("Inside a brand new chunk 0002 again");

Log::Log4perl::MDC->put('chunk' , undef );
## End of chunk 0002
$LOGGER->info("Left chunk context");
$LOGGER->info("Left chunk context again");