1###################################################################### 2# Limit.pm -- 2003, Mike Schilli <m@perlmeister.com> 3###################################################################### 4# Special composite appender limiting the number of messages relayed 5# to its appender(s). 6###################################################################### 7 8########################################### 9package Log::Log4perl::Appender::Limit; 10########################################### 11 12use strict; 13use warnings; 14use Storable; 15 16our @ISA = qw(Log::Log4perl::Appender); 17 18our $CVSVERSION = '$Revision: 1.7 $'; 19our ($VERSION) = ($CVSVERSION =~ /(\d+\.\d+)/); 20 21########################################### 22sub new { 23########################################### 24 my($class, %options) = @_; 25 26 my $self = { 27 max_until_flushed => undef, 28 max_until_discarded => undef, 29 appender_method_on_flush 30 => undef, 31 appender => undef, 32 accumulate => 1, 33 persistent => undef, 34 block_period => 3600, 35 buffer => [], 36 %options, 37 }; 38 39 # Pass back the appender to be limited as a dependency 40 # to the configuration file parser 41 push @{$options{l4p_depends_on}}, $self->{appender}; 42 43 # Run our post_init method in the configurator after 44 # all appenders have been defined to make sure the 45 # appenders we're connecting to really exist. 46 push @{$options{l4p_post_config_subs}}, sub { $self->post_init() }; 47 48 bless $self, $class; 49 50 if(defined $self->{persistent}) { 51 $self->restore(); 52 } 53 54 return $self; 55} 56 57########################################### 58sub log { 59########################################### 60 my($self, %params) = @_; 61 62 local $Log::Log4perl::caller_depth = 63 $Log::Log4perl::caller_depth + 2; 64 65 # Check if message needs to be discarded 66 my $discard = 0; 67 if(defined $self->{max_until_discarded} and 68 scalar @{$self->{buffer}} >= $self->{max_until_discarded} - 1) { 69 $discard = 1; 70 } 71 72 # Check if we need to flush 73 my $flush = 0; 74 if(defined $self->{max_until_flushed} and 75 scalar @{$self->{buffer}} >= $self->{max_until_flushed} - 1) { 76 $flush = 1; 77 } 78 79 if(!$flush and 80 (exists $self->{sent_last} and 81 $self->{sent_last} + $self->{block_period} > time() 82 ) 83 ) { 84 # Message needs to be blocked for now. 85 return if $discard; 86 87 # Ask the appender to save a cached message in $cache 88 $self->{app}->SUPER::log(\%params, 89 $params{log4p_category}, 90 $params{log4p_level}, \my $cache); 91 92 # Save message and other parameters 93 push @{$self->{buffer}}, $cache if $self->{accumulate}; 94 95 $self->save() if $self->{persistent}; 96 97 return; 98 } 99 100 # Relay all messages we got to the SUPER class, which needs to render the 101 # messages according to the appender's layout, first. 102 103 # Log pending messages if we have any 104 $self->flush(); 105 106 # Log current message as well 107 $self->{app}->SUPER::log(\%params, 108 $params{log4p_category}, 109 $params{log4p_level}); 110 111 $self->{sent_last} = time(); 112 113 # We need to store the timestamp persistently, if requested 114 $self->save() if $self->{persistent}; 115} 116 117########################################### 118sub post_init { 119########################################### 120 my($self) = @_; 121 122 if(! exists $self->{appender}) { 123 die "No appender defined for " . __PACKAGE__; 124 } 125 126 my $appenders = Log::Log4perl->appenders(); 127 my $appender = Log::Log4perl->appenders()->{$self->{appender}}; 128 129 if(! defined $appender) { 130 die "Appender $self->{appender} not defined (yet) when " . 131 __PACKAGE__ . " needed it"; 132 } 133 134 $self->{app} = $appender; 135} 136 137########################################### 138sub save { 139########################################### 140 my($self) = @_; 141 142 my $pdata = [$self->{buffer}, $self->{sent_last}]; 143 144 # Save the buffer if we're in persistent mode 145 store $pdata, $self->{persistent} or 146 die "Cannot save messages in $self->{persistent} ($!)"; 147} 148 149########################################### 150sub restore { 151########################################### 152 my($self) = @_; 153 154 if(-f $self->{persistent}) { 155 my $pdata = retrieve $self->{persistent} or 156 die "Cannot retrieve messages from $self->{persistent} ($!)"; 157 ($self->{buffer}, $self->{sent_last}) = @$pdata; 158 } 159} 160 161########################################### 162sub flush { 163########################################### 164 my($self) = @_; 165 166 # Log pending messages if we have any 167 for(@{$self->{buffer}}) { 168 $self->{app}->SUPER::log_cached($_); 169 } 170 171 # call flush() on the attached appender if so desired. 172 if( $self->{appender_method_on_flush} ) { 173 no strict 'refs'; 174 my $method = $self->{appender_method_on_flush}; 175 $self->{app}->$method(); 176 } 177 178 # Empty buffer 179 $self->{buffer} = []; 180} 181 182########################################### 183sub DESTROY { 184########################################### 185 my($self) = @_; 186 187} 188 1891; 190 191__END__ 192 193=head1 NAME 194 195 Log::Log4perl::Appender::Limit - Limit message delivery via block period 196 197=head1 SYNOPSIS 198 199 use Log::Log4perl qw(:easy); 200 201 my $conf = qq( 202 log4perl.category = WARN, Limiter 203 204 # Email appender 205 log4perl.appender.Mailer = Log::Dispatch::Email::MailSend 206 log4perl.appender.Mailer.to = drone\@pageme.com 207 log4perl.appender.Mailer.subject = Something's broken! 208 log4perl.appender.Mailer.buffered = 0 209 log4perl.appender.Mailer.layout = PatternLayout 210 log4perl.appender.Mailer.layout.ConversionPattern=%d %m %n 211 212 # Limiting appender, using the email appender above 213 log4perl.appender.Limiter = Log::Log4perl::Appender::Limit 214 log4perl.appender.Limiter.appender = Mailer 215 log4perl.appender.Limiter.block_period = 3600 216 ); 217 218 Log::Log4perl->init(\$conf); 219 WARN("This message will be sent immediately."); 220 WARN("This message will be delayed by one hour."); 221 sleep(3601); 222 WARN("This message plus the last one will be sent now, seperately."); 223 224=head1 DESCRIPTION 225 226=over 4 227 228=item C<appender> 229 230Specifies the name of the appender used by the limiter. The 231appender specified must be defined somewhere in the configuration file, 232not necessarily before the definition of 233C<Log::Log4perl::Appender::Limit>. 234 235=item C<block_period> 236 237Period in seconds between delivery of messages. If messages arrive in between, 238they will be either saved (if C<accumulate> is set to a true value) or 239discarded (if C<accumulate> isn't set). 240 241=item C<persistent> 242 243File name in which C<Log::Log4perl::Appender::Limit> persistently stores 244delivery times. If omitted, the appender will have no recollection of what 245happened when the program restarts. 246 247=item C<max_until_flushed> 248 249Maximum number of accumulated messages. If exceeded, the appender flushes 250all messages, regardless if the interval set in C<block_period> 251has passed or not. Don't mix with C<max_until_discarded>. 252 253=item C<max_until_discarded> 254 255Maximum number of accumulated messages. If exceeded, the appender will 256simply discard additional messages, waiting for C<block_period> to expire 257to flush all accumulated messages. Don't mix with C<max_until_flushed>. 258 259=item C<appender_method_on_flush> 260 261Optional method name to be called on the appender attached to the 262limiter when messages are flushed. For example, to have the sample code 263in the SYNOPSIS section bundle buffered emails into one, change the 264mailer's C<buffered> parameter to C<1> and set the limiters 265C<appender_method_on_flush> value to the string C<"flush">: 266 267 log4perl.category = WARN, Limiter 268 269 # Email appender 270 log4perl.appender.Mailer = Log::Dispatch::Email::MailSend 271 log4perl.appender.Mailer.to = drone\@pageme.com 272 log4perl.appender.Mailer.subject = Something's broken! 273 log4perl.appender.Mailer.buffered = 1 274 log4perl.appender.Mailer.layout = PatternLayout 275 log4perl.appender.Mailer.layout.ConversionPattern=%d %m %n 276 277 # Limiting appender, using the email appender above 278 log4perl.appender.Limiter = Log::Log4perl::Appender::Limit 279 log4perl.appender.Limiter.appender = Mailer 280 log4perl.appender.Limiter.block_period = 3600 281 log4perl.appender.Limiter.appender_method_on_flush = flush 282 283This will cause the mailer to buffer messages and wait for C<flush()> 284to send out the whole batch. The limiter will then call the appender's 285C<flush()> method when it's own buffer gets flushed out. 286 287=back 288 289If the appender attached to C<Limit> uses C<PatternLayout> with a timestamp 290specifier, you will notice that the message timestamps are reflecting the 291original log event, not the time of the message rendering in the 292attached appender. Major trickery has been applied to accomplish 293this (Cough!). 294 295=head1 DEVELOPMENT NOTES 296 297C<Log::Log4perl::Appender::Limit> is a I<composite> appender. 298Unlike other appenders, it doesn't log any messages, it just 299passes them on to its attached sub-appender. 300For this reason, it doesn't need a layout (contrary to regular appenders). 301If it defines none, messages are passed on unaltered. 302 303Custom filters are also applied to the composite appender only. 304They are I<not> applied to the sub-appender. Same applies to appender 305thresholds. This behaviour might change in the future. 306 307=head1 LICENSE 308 309Copyright 2002-2012 by Mike Schilli E<lt>m@perlmeister.comE<gt> 310and Kevin Goess E<lt>cpan@goess.orgE<gt>. 311 312This library is free software; you can redistribute it and/or modify 313it under the same terms as Perl itself. 314 315=head1 AUTHOR 316 317Please contribute patches to the project on Github: 318 319 http://github.com/mschilli/log4perl 320 321Send bug reports or requests for enhancements to the authors via our 322 323MAILING LIST (questions, bug reports, suggestions/patches): 324log4perl-devel@lists.sourceforge.net 325 326Authors (please contact them via the list above, not directly): 327Mike Schilli <m@perlmeister.com>, 328Kevin Goess <cpan@goess.org> 329 330Contributors (in alphabetical order): 331Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 332Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 333Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 334Grundman, Paul Harrington, David Hull, Robert Jacobson, Jason Kohles, 335Jeff Macdonald, Markus Peter, Brett Rann, Peter Rabbitson, Erik 336Selberg, Aaron Straup Cope, Lars Thegler, David Viner, Mac Yang. 337 338