package Log::Log4perl::Appender::Buffer;
use strict;
use warnings;
our @ISA = qw(Log::Log4perl::Appender);
our $CVSVERSION = '$Revision: 1.2 $';
our ($VERSION) = ($CVSVERSION =~ /(\d+\.\d+)/);
sub new {
my($class, %options) = @_;
my $self = {
appender=> undef,
buffer => [],
options => {
max_messages => undef,
trigger => undef,
trigger_level => undef,
},
level => 0,
%options,
};
if($self->{trigger_level}) {
$self->{trigger} = level_trigger($self->{trigger_level});
}
push @{$options{l4p_depends_on}}, $self->{appender};
push @{$options{l4p_post_config_subs}}, sub { $self->post_init() };
bless $self, $class;
}
sub log {
my($self, %params) = @_;
if(defined $self->{max_messages} and
@{$self->{buffer}} == $self->{max_messages}) {
shift @{$self->{buffer}};
}
$params{log4p_logtime} = $self->{app}->{layout}->{time_function}->() if
exists $self->{app}->{layout}->{time_function};
push @{$self->{buffer}}, \%params;
$self->flush() if $self->{trigger}->($self, \%params);
}
sub flush {
my($self) = @_;
for(@{$self->{buffer}}) {
local $self->{app}->{layout}->{time_function};
$self->{app}->{layout}->{time_function} =
sub { $_->{log4p_logtime} };
$self->{app}->SUPER::log($_,
$_->{log4p_category},
$_->{log4p_level});
}
$self->{buffer} = [];
}
sub post_init {
my($self) = @_;
if(! exists $self->{appender}) {
die "No appender defined for " . __PACKAGE__;
}
my $appenders = Log::Log4perl->appenders();
my $appender = Log::Log4perl->appenders()->{$self->{appender}};
if(! defined $appender) {
die "Appender $self->{appender} not defined (yet) when " .
__PACKAGE__ . " needed it";
}
$self->{app} = $appender;
}
sub level_trigger {
my($level) = @_;
return sub {
my($self, $params) = @_;
return Log::Log4perl::Level::to_priority(
$params->{log4p_level}) >=
Log::Log4perl::Level::to_priority($level);
};
}
sub DESTROY {
my($self) = @_;
}
1;
__END__
=head1 NAME
Log::Log4perl::Appender::Buffer - Buffering Appender
=head1 SYNOPSIS
use Log::Log4perl qw(:easy);
my $conf = qq(
log4perl.category = DEBUG, Buffer
# Regular Screen Appender
log4perl.appender.Screen = Log::Log4perl::Appender::Screen
log4perl.appender.Screen.stdout = 1
log4perl.appender.Screen.layout = PatternLayout
log4perl.appender.Screen.layout.ConversionPattern = %d %p %c %m %n
# Buffering appender, using the appender above as outlet
log4perl.appender.Buffer = Log::Log4perl::Appender::Buffer
log4perl.appender.Buffer.appender = Screen
log4perl.appender.Buffer.trigger_level = ERROR
);
Log::Log4perl->init(\$conf);
DEBUG("This message gets buffered.");
INFO("This message gets buffered also.");
# Time passes. Nothing happens. But then ...
print "It's GO time!!!\n";
ERROR("This message triggers a buffer flush.");
=head1 DESCRIPTION
C<Log::Log4perl::Appender::Buffer> takes these arguments:
=over 4
=item C<appender>
Specifies the name of the appender it buffers messages for. The
appender specified must be defined somewhere in the configuration file,
not necessarily before the definition of
C<Log::Log4perl::Appender::Buffer>.
=item C<max_messages>
Specifies the maximum number of messages the appender will hold in
its ring buffer. C<max_messages> is optional. By default,
C<Log::Log4perl::Appender::Buffer> will I<not> limit the number of
messages buffered. This might be undesirable in long-running processes
accumulating lots of messages before a flush happens. If
C<max_messages> is set to a numeric value,
C<Log::Log4perl::Appender::Buffer> will displace old messages in its
buffer to make room if the buffer is full.
=item C<trigger_level>
If trigger_level is set to one of Log4perl's levels (see
Log::Log4perl::Level), a C<trigger> function will be defined internally
to flush the buffer if a message with a priority of $level or higher
comes along. This is just a convenience function. Defining
log4perl.appender.Buffer.trigger_level = ERROR
is equivalent to creating a trigger function like
log4perl.appender.Buffer.trigger = sub { \
my($self, $params) = @_; \
return $params->{log4p_level} >= \
$Log::Log4perl::Level::ERROR; }
See the next section for defining generic trigger functions.
=item C<trigger>
C<trigger> holds a reference to a subroutine, which
C<Log::Log4perl::Appender::Buffer> will call on every incoming message
with the same parameters as the appender's C<log()> method:
my($self, $params) = @_;
C<$params> references a hash containing
the message priority (key C<l4p_level>), the
message category (key C<l4p_category>) and the content of the message
(key C<message>).
If the subroutine returns 1, it will trigger a flush of buffered messages.
Shortcut
=back
=head1 DEVELOPMENT NOTES
C<Log::Log4perl::Appender::Buffer> is a I<composite> appender.
Unlike other appenders, it doesn't log any messages, it just
passes them on to its attached sub-appender.
For this reason, it doesn't need a layout (contrary to regular appenders).
If it defines none, messages are passed on unaltered.
Custom filters are also applied to the composite appender only.
They are I<not> applied to the sub-appender. Same applies to appender
thresholds. This behaviour might change in the future.
=head1 LEGALESE
Copyright 2004 by Mike Schilli, all rights reserved.
This program is free software, you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 AUTHOR
2004, Mike Schilli <m@perlmeister.com>