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