1######################################################################
2# Buffer.pm -- 2004, Mike Schilli <m@perlmeister.com>
3######################################################################
4# Composite appender buffering messages until a trigger condition is met.
5######################################################################
6
7###########################################
8package Log::Log4perl::Appender::Buffer;
9###########################################
10
11use strict;
12use warnings;
13
14our @ISA = qw(Log::Log4perl::Appender);
15
16our $CVSVERSION   = '$Revision: 1.2 $';
17our ($VERSION)    = ($CVSVERSION =~ /(\d+\.\d+)/);
18
19###########################################
20sub new {
21###########################################
22    my($class, %options) = @_;
23
24    my $self = {
25        appender=> undef,
26        buffer  => [],
27        options => {
28            max_messages  => undef,
29            trigger       => undef,
30            trigger_level => undef,
31        },
32        level   => 0,
33        %options,
34    };
35
36    if($self->{trigger_level}) {
37        $self->{trigger} = level_trigger($self->{trigger_level});
38    }
39
40        # Pass back the appender to be synchronized as a dependency
41        # to the configuration file parser
42    push @{$options{l4p_depends_on}}, $self->{appender};
43
44        # Run our post_init method in the configurator after
45        # all appenders have been defined to make sure the
46        # appender we're playing 'dam' for really exists
47    push @{$options{l4p_post_config_subs}}, sub { $self->post_init() };
48
49    bless $self, $class;
50}
51
52###########################################
53sub log {
54###########################################
55    my($self, %params) = @_;
56
57    local $Log::Log4perl::caller_depth =
58        $Log::Log4perl::caller_depth + 2;
59
60        # Do we need to discard a message because there's already
61        # max_size messages in the buffer?
62    if(defined $self->{max_messages} and
63       @{$self->{buffer}} == $self->{max_messages}) {
64        shift @{$self->{buffer}};
65    }
66        # Ask the appender to save a cached message in $cache
67    $self->{app}->SUPER::log(\%params,
68                         $params{log4p_category},
69                         $params{log4p_level}, \my $cache);
70
71        # Save it in the appender's message buffer, but only if
72        # it hasn't been suppressed by an appender threshold
73    if( defined $cache ) {
74        push @{ $self->{buffer} }, $cache;
75    }
76
77    $self->flush() if $self->{trigger}->($self, \%params);
78}
79
80###########################################
81sub flush {
82###########################################
83    my($self) = @_;
84
85        # Flush pending messages if we have any
86    for my $cache (@{$self->{buffer}}) {
87        $self->{app}->SUPER::log_cached($cache);
88    }
89
90        # Empty buffer
91    $self->{buffer} = [];
92}
93
94###########################################
95sub post_init {
96###########################################
97    my($self) = @_;
98
99    if(! exists $self->{appender}) {
100       die "No appender defined for " . __PACKAGE__;
101    }
102
103    my $appenders = Log::Log4perl->appenders();
104    my $appender = Log::Log4perl->appenders()->{$self->{appender}};
105
106    if(! defined $appender) {
107       die "Appender $self->{appender} not defined (yet) when " .
108           __PACKAGE__ . " needed it";
109    }
110
111    $self->{app} = $appender;
112}
113
114###########################################
115sub level_trigger {
116###########################################
117    my($level) = @_;
118
119        # closure holding $level
120    return sub {
121        my($self, $params) = @_;
122
123        return Log::Log4perl::Level::to_priority(
124                 $params->{log4p_level}) >=
125               Log::Log4perl::Level::to_priority($level);
126    };
127}
128
129###########################################
130sub DESTROY {
131###########################################
132    my($self) = @_;
133}
134
1351;
136
137__END__
138
139=head1 NAME
140
141    Log::Log4perl::Appender::Buffer - Buffering Appender
142
143=head1 SYNOPSIS
144
145    use Log::Log4perl qw(:easy);
146
147    my $conf = qq(
148    log4perl.category                  = DEBUG, Buffer
149
150        # Regular Screen Appender
151    log4perl.appender.Screen           = Log::Log4perl::Appender::Screen
152    log4perl.appender.Screen.stdout    = 1
153    log4perl.appender.Screen.layout    = PatternLayout
154    log4perl.appender.Screen.layout.ConversionPattern = %d %p %c %m %n
155
156        # Buffering appender, using the appender above as outlet
157    log4perl.appender.Buffer               = Log::Log4perl::Appender::Buffer
158    log4perl.appender.Buffer.appender      = Screen
159    log4perl.appender.Buffer.trigger_level = ERROR
160    );
161
162    Log::Log4perl->init(\$conf);
163
164    DEBUG("This message gets buffered.");
165    INFO("This message gets buffered also.");
166
167    # Time passes. Nothing happens. But then ...
168
169    print "It's GO time!!!\n";
170
171    ERROR("This message triggers a buffer flush.");
172
173=head1 DESCRIPTION
174
175C<Log::Log4perl::Appender::Buffer> takes these arguments:
176
177=over 4
178
179=item C<appender>
180
181Specifies the name of the appender it buffers messages for. The
182appender specified must be defined somewhere in the configuration file,
183not necessarily before the definition of
184C<Log::Log4perl::Appender::Buffer>.
185
186=item C<max_messages>
187
188Specifies the maximum number of messages the appender will hold in
189its ring buffer. C<max_messages> is optional. By default,
190C<Log::Log4perl::Appender::Buffer> will I<not> limit the number of
191messages buffered. This might be undesirable in long-running processes
192accumulating lots of messages before a flush happens. If
193C<max_messages> is set to a numeric value,
194C<Log::Log4perl::Appender::Buffer> will displace old messages in its
195buffer to make room if the buffer is full.
196
197=item C<trigger_level>
198
199If trigger_level is set to one of Log4perl's levels (see
200Log::Log4perl::Level), a C<trigger> function will be defined internally
201to flush the buffer if a message with a priority of $level or higher
202comes along. This is just a convenience function. Defining
203
204    log4perl.appender.Buffer.trigger_level = ERROR
205
206is equivalent to creating a trigger function like
207
208    log4perl.appender.Buffer.trigger = sub {   \
209        my($self, $params) = @_;               \
210        return $params->{log4p_level} >=       \
211               $Log::Log4perl::Level::ERROR; }
212
213See the next section for defining generic trigger functions.
214
215=item C<trigger>
216
217C<trigger> holds a reference to a subroutine, which
218C<Log::Log4perl::Appender::Buffer> will call on every incoming message
219with the same parameters as the appender's C<log()> method:
220
221        my($self, $params) = @_;
222
223C<$params> references a hash containing
224the message priority (key C<l4p_level>), the
225message category (key C<l4p_category>) and the content of the message
226(key C<message>).
227
228If the subroutine returns 1, it will trigger a flush of buffered messages.
229
230Shortcut
231
232=back
233
234=head1 DEVELOPMENT NOTES
235
236C<Log::Log4perl::Appender::Buffer> is a I<composite> appender.
237Unlike other appenders, it doesn't log any messages, it just
238passes them on to its attached sub-appender.
239For this reason, it doesn't need a layout (contrary to regular appenders).
240If it defines none, messages are passed on unaltered.
241
242Custom filters are also applied to the composite appender only.
243They are I<not> applied to the sub-appender. Same applies to appender
244thresholds. This behaviour might change in the future.
245
246=head1 LICENSE
247
248Copyright 2002-2012 by Mike Schilli E<lt>m@perlmeister.comE<gt>
249and Kevin Goess E<lt>cpan@goess.orgE<gt>.
250
251This library is free software; you can redistribute it and/or modify
252it under the same terms as Perl itself.
253
254=head1 AUTHOR
255
256Please contribute patches to the project on Github:
257
258    http://github.com/mschilli/log4perl
259
260Send bug reports or requests for enhancements to the authors via our
261
262MAILING LIST (questions, bug reports, suggestions/patches):
263log4perl-devel@lists.sourceforge.net
264
265Authors (please contact them via the list above, not directly):
266Mike Schilli <m@perlmeister.com>,
267Kevin Goess <cpan@goess.org>
268
269Contributors (in alphabetical order):
270Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
271Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
272Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
273Grundman, Paul Harrington, David Hull, Robert Jacobson, Jason Kohles,
274Jeff Macdonald, Markus Peter, Brett Rann, Peter Rabbitson, Erik
275Selberg, Aaron Straup Cope, Lars Thegler, David Viner, Mac Yang.
276
277