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 # Do we need to discard a message because there's already 58 # max_size messages in the buffer? 59 if(defined $self->{max_messages} and 60 @{$self->{buffer}} == $self->{max_messages}) { 61 shift @{$self->{buffer}}; 62 } 63 64 # Save event time for later 65 $params{log4p_logtime} = $self->{app}->{layout}->{time_function}->() if 66 exists $self->{app}->{layout}->{time_function}; 67 68 # Save message and other parameters 69 push @{$self->{buffer}}, \%params; 70 71 $self->flush() if $self->{trigger}->($self, \%params); 72} 73 74########################################### 75sub flush { 76########################################### 77 my($self) = @_; 78 79 # Log pending messages if we have any 80 for(@{$self->{buffer}}) { 81 # Trick the renderer into using the original event time 82 local $self->{app}->{layout}->{time_function}; 83 $self->{app}->{layout}->{time_function} = 84 sub { $_->{log4p_logtime} }; 85 $self->{app}->SUPER::log($_, 86 $_->{log4p_category}, 87 $_->{log4p_level}); 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 LEGALESE 247 248Copyright 2004 by Mike Schilli, all rights reserved. 249This program is free software, you can redistribute it and/or 250modify it under the same terms as Perl itself. 251 252=head1 AUTHOR 253 2542004, Mike Schilli <m@perlmeister.com> 255