view release on metacpan or  search on metacpan

lib/Log/Log4perl/Appender/Chunk.pm  view on Meta::CPAN

package Log::Log4perl::Appender::Chunk;
$Log::Log4perl::Appender::Chunk::VERSION = '0.013';
use Moose;

use Carp;
use Class::Load;
use Data::Dumper;
use Log::Log4perl::MDC;


# State variables:

# State can be:
# OFFCHUNK: No chunk is currently captured.
# INCHUNK: A chunk is currently captured in the buffer
# ENTERCHUNK: Entering a chunk from an OFFCHUNK state
# NEWCHUNK: Entering a NEW chunk from an INCHUNK state
# LEAVECHUNK: Leaving a chunk from an INCHUNK state

has '_creator_pid' => ( is => 'ro', isa => 'Int', required => 1 , default => sub{  $$ ; } );

has 'state' => ( is => 'rw' , isa => 'Str', default => 'OFFCHUNK' );
has 'previous_chunk' => ( is => 'rw' , isa => 'Maybe[Str]' , default => undef , writer => '_set_previous_chunk' );
has 'messages_buffer' => ( is => 'rw' , isa => 'ArrayRef[Str]' , default => sub{ []; });

# Settings:
has 'chunk_marker' => ( is => 'ro' , isa => 'Str', required => 1, default => 'chunk' );

# Store:
has 'store' => ( is => 'ro', isa => 'Log::Log4perl::Appender::Chunk::Store',
                 required => 1, lazy_build => 1);
has 'store_class' => ( is => 'ro' , isa => 'Str' , default => 'Null' );
has 'store_args'  => ( is => 'ro' , isa => 'HashRef' , default => sub{ {}; });

has 'store_builder' => ( is => 'ro' , isa => 'CodeRef', required => 1, default => sub{
                             my ($self) = @_;
                             sub{
                                 $self->_full_store_class()->new($self->store_args());
                             }
                         });

sub _build_store{
    my ($self) = @_;
    return $self->store_builder()->();
}

sub _full_store_class{
    my ($self) = @_;
    my $full_class = $self->store_class();
    if( $full_class =~ /^\+/ ){
        $full_class =~ s/^\+//;
    }else{
        $full_class = 'Log::Log4perl::Appender::Chunk::Store::'.$full_class;
    }
    Class::Load::load_class($full_class);
    return $full_class;
}


sub log{
    my ($self, %params) = @_;

    ## Any log within this method will be discarded.
    if( Log::Log4perl::MDC->get(__PACKAGE__.'-reentrance') ){
      return;
    }
    Log::Log4perl::MDC->put(__PACKAGE__.'-reentrance', 1);

    my $chunk = Log::Log4perl::MDC->get($self->chunk_marker());

    # Change the state according to the chunk param
    $self->state( $self->_compute_state($chunk) );

    # Act according to the state.
    my $m_name = '_on_'.$self->state();

    $self->$m_name(\%params);

    $self->_set_previous_chunk($chunk);
    Log::Log4perl::MDC->put(__PACKAGE__.'-reentrance', undef);
}

sub _on_OFFCHUNK{
    my ($self, $params) = @_;
    # Chunk is Off, nothing much to do.
}

sub _on_ENTERCHUNK{
    my ($self,$params) = @_;
    # Push the message in the buffer.
    push @{$self->messages_buffer()} , $params->{message};
}