File Coverage

blib/lib/Log/Log4perl/Appender/Buffer.pm
Criterion Covered Total %
statement 39 45 86.6
branch 9 12 75.0
condition 1 3 33.3
subroutine 9 10 90.0
pod 1 5 20.0
total 59 75 78.6


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