1########################################### 2# Test Suite for Composite Appenders 3# Mike Schilli, 2004 (m@perlmeister.com) 4########################################### 5 6BEGIN { 7 if($ENV{INTERNAL_DEBUG}) { 8 require Log::Log4perl::InternalDebug; 9 Log::Log4perl::InternalDebug->enable(); 10 } 11} 12 13use warnings; 14use strict; 15 16use Test::More; 17 18BEGIN { 19 eval { 20 require Storable; 21 }; 22 if ($@) { 23 plan skip_all => "only with Storable"; # Limit.pm needs it and 24 # early Perl versions dont 25 # have it. 26 }else{ 27 plan tests => 20; 28 } 29} 30 31use Log::Log4perl qw(get_logger :levels); 32use Log::Log4perl::Level; 33use Log::Log4perl::Appender::TestBuffer; 34 35ok(1); # If we made it this far, we/re ok. 36 37################################################## 38# Limit Appender 39################################################## 40# Reset appender population 41Log::Log4perl::Appender::TestBuffer->reset(); 42 43my $conf = qq( 44 log4perl.category = WARN, Limiter 45 46 # Email appender 47 log4perl.appender.Buffer = Log::Log4perl::Appender::TestBuffer 48 log4perl.appender.Buffer.layout = PatternLayout 49 log4perl.appender.Buffer.layout.ConversionPattern=%d %m %n 50 51 # Limiting appender, using the email appender above 52 log4perl.appender.Limiter = Log::Log4perl::Appender::Limit 53 log4perl.appender.Limiter.appender = Buffer 54 log4perl.appender.Limiter.block_period = 3600 55); 56 57Log::Log4perl->init(\$conf); 58 59my $logger = get_logger(""); 60$logger->warn("This message will be sent immediately"); 61$logger->warn("This message will be delayed by one hour."); 62 63my $buffer = Log::Log4perl::Appender::TestBuffer->by_name("Buffer"); 64like($buffer->buffer(), qr/immediately/); 65unlike($buffer->buffer(), qr/delayed/); 66 67 # Now flush the limiter and check again. The delayed message should now 68 # be there. 69my $limit = Log::Log4perl->appenders()->{Limiter}; 70$limit->flush(); 71 72like($buffer->buffer(), qr/immediately/); 73like($buffer->buffer(), qr/delayed/); 74 75$buffer->reset(); 76 # Nothing to flush 77$limit->flush(); 78is($buffer->buffer(), ""); 79 80################################################## 81# Flush method 82################################################## 83$conf .= <<EOT; 84 log4perl.appender.Limiter.appender_method_on_flush = clear 85EOT 86Log::Log4perl->init(\$conf); 87$buffer = Log::Log4perl::Appender::TestBuffer->by_name("Buffer"); 88$logger = get_logger(""); 89$logger->warn("This message will be queued but discarded on flush."); 90$limit = Log::Log4perl->appenders()->{Limiter}; 91$limit->flush(); 92 93is($buffer->buffer(), ""); 94 95################################################## 96# Limit Appender with max_until_discard 97################################################## 98# Reset appender population 99Log::Log4perl::Appender::TestBuffer->reset(); 100 101$conf = qq( 102 log4perl.category = WARN, Limiter 103 104 # Email appender 105 log4perl.appender.Buffer = Log::Log4perl::Appender::TestBuffer 106 log4perl.appender.Buffer.layout = PatternLayout 107 log4perl.appender.Buffer.layout.ConversionPattern=%d %m %n 108 109 # Limiting appender, using the email appender above 110 log4perl.appender.Limiter = Log::Log4perl::Appender::Limit 111 log4perl.appender.Limiter.appender = Buffer 112 log4perl.appender.Limiter.block_period = 3600 113 log4perl.appender.Limiter.max_until_discarded = 1 114); 115 116Log::Log4perl->init(\$conf); 117 118$logger = get_logger(""); 119$logger->warn("This message will be sent immediately"); 120for(1..10) { 121 $logger->warn("This message will be discarded"); 122} 123 124 # Artificially flush the limit appender 125$limit = Log::Log4perl->appenders()->{Limiter}; 126$limit->flush(); 127 128$buffer = Log::Log4perl::Appender::TestBuffer->by_name("Buffer"); 129like($buffer->buffer(), qr/immediately/); 130unlike($buffer->buffer(), qr/discarded/); 131 132################################################## 133# Limit Appender with max_until_discard 134################################################## 135# Reset appender population 136Log::Log4perl::Appender::TestBuffer->reset(); 137 138$conf = qq( 139 log4perl.category = WARN, Limiter 140 141 # Email appender 142 log4perl.appender.Buffer = Log::Log4perl::Appender::TestBuffer 143 log4perl.appender.Buffer.layout = PatternLayout 144 log4perl.appender.Buffer.layout.ConversionPattern=%d %m %n 145 146 # Limiting appender, using the email appender above 147 log4perl.appender.Limiter = Log::Log4perl::Appender::Limit 148 log4perl.appender.Limiter.appender = Buffer 149 log4perl.appender.Limiter.block_period = 3600 150 log4perl.appender.Limiter.max_until_discarded = 1 151); 152 153Log::Log4perl->init(\$conf); 154 155$logger = get_logger(""); 156$logger->warn("This message will be sent immediately"); 157for(1..10) { 158 $logger->warn("This message will be discarded"); 159} 160 161 # Artificially flush the limit appender 162$limit = Log::Log4perl->appenders()->{Limiter}; 163$limit->flush(); 164 165$buffer = Log::Log4perl::Appender::TestBuffer->by_name("Buffer"); 166like($buffer->buffer(), qr/immediately/); 167unlike($buffer->buffer(), qr/discarded/); 168 169################################################## 170# Limit Appender with max_until_flushed 171################################################## 172# Reset appender population 173Log::Log4perl::Appender::TestBuffer->reset(); 174 175$conf = qq( 176 log4perl.category = WARN, Limiter 177 178 # Email appender 179 log4perl.appender.Buffer = Log::Log4perl::Appender::TestBuffer 180 log4perl.appender.Buffer.layout = PatternLayout 181 log4perl.appender.Buffer.layout.ConversionPattern=%d %m %n 182 183 # Limiting appender, using the email appender above 184 log4perl.appender.Limiter = Log::Log4perl::Appender::Limit 185 log4perl.appender.Limiter.appender = Buffer 186 log4perl.appender.Limiter.block_period = 3600 187 log4perl.appender.Limiter.max_until_flushed = 2 188); 189 190Log::Log4perl->init(\$conf); 191 192$logger = get_logger(""); 193$logger->warn("This message will be sent immediately"); 194$logger->warn("This message won't show right away"); 195 196$buffer = Log::Log4perl::Appender::TestBuffer->by_name("Buffer"); 197like($buffer->buffer(), qr/immediately/); 198unlike($buffer->buffer(), qr/right away/); 199 200$logger->warn("This message will show right away"); 201like($buffer->buffer(), qr/right away/); 202 203 204################################# 205#demonstrating bug in Limiter.pm regarding $_ 206# Reset appender population 207Log::Log4perl::Appender::TestBuffer->reset(); 208 209{package My::Test::Appender; 210our @ISA = ('Log::Log4perl::Appender::TestBuffer'); 211sub new { 212 my $self = shift; 213 $_ = ''; #aye, there's the rub! 214 $self->SUPER::new; 215} 216} 217 218$conf = qq( 219 log4perl.category = WARN, Limiter 220 221 log4perl.appender.Buffer = My::Test::Appender 222 log4perl.appender.Buffer.layout = SimpleLayout 223 log4perl.appender.Buffer.layout.ConversionPattern=%d %m %n 224 225 log4perl.appender.Limiter = Log::Log4perl::Appender::Limit 226 log4perl.appender.Limiter.appender = Buffer 227 log4perl.appender.Limiter.block_period = 3600 228); 229 230Log::Log4perl->init(\$conf); 231ok(1); 232 233### API initialization 234# 235Log::Log4perl->reset(); 236my $bufApp = Log::Log4perl::Appender->new( 237 'Log::Log4perl::Appender::TestBuffer', 238 name => 'MyBuffer', 239 ); 240$bufApp->layout( 241 Log::Log4perl::Layout::PatternLayout::Multiline->new( 242 '%m%n') 243 ); 244# Make the appender known to the system (without assigning it to 245# any logger 246Log::Log4perl->add_appender( $bufApp ); 247 248my $limitApp = Log::Log4perl::Appender->new( 249 'Log::Log4perl::Appender::Limit', 250 name => 'MyLimit', 251 appender => 'MyBuffer', 252 key => 'nem', 253 ); 254$limitApp->post_init(); 255$limitApp->composite(1); 256 257$buffer = Log::Log4perl::Appender::TestBuffer->by_name("MyBuffer"); 258get_logger("")->add_appender($limitApp); 259get_logger("")->level($DEBUG); 260get_logger("wonk")->debug("waah!"); 261is($buffer->buffer(), "waah!\n", "composite api init"); 262 263### Wrong %M with caching appender 264# 265Log::Log4perl->reset(); 266Log::Log4perl::Appender::TestBuffer->reset(); 267 268$conf = qq( 269 log4perl.category = WARN, Limiter 270 271 # TestBuffer appender 272 log4perl.appender.Buffer = Log::Log4perl::Appender::TestBuffer 273 log4perl.appender.Buffer.layout = PatternLayout 274 log4perl.appender.Buffer.layout.ConversionPattern=%d cat=%c meth=%M %m %n 275 276 # Limiting appender, using the email appender above 277 log4perl.appender.Limiter = Log::Log4perl::Appender::Limit 278 log4perl.appender.Limiter.appender = Buffer 279 log4perl.appender.Limiter.block_period = 3600 280 log4perl.appender.Limiter.max_until_flushed = 2 281); 282 283Log::Log4perl->init(\$conf); 284 285$logger = get_logger(); 286 287$logger->warn("Sent from main"); 288 289package Willy::Wonka; 290sub func { 291 use Log::Log4perl qw(get_logger); 292 my $logger = get_logger(); 293 $logger->warn("Sent from func"); 294} 295package main; 296 297Willy::Wonka::func(); 298$logger->warn("Sent from main"); 299 300$buffer = Log::Log4perl::Appender::TestBuffer->by_name("Buffer"); 301like($buffer->buffer(), 302 qr/cat=main meth=main::.*cat=Willy.Wonka meth=Willy::Wonka::func/s, 303 "%M/%c with composite appender"); 304 305### Different caller stacks with normal vs. composite appenders 306Log::Log4perl->reset(); 307 308$conf = qq( 309 log4perl.category = WARN, Buffer1, Composite 310 311 # 1st TestBuffer appender 312 log4perl.appender.Buffer1 = Log::Log4perl::Appender::TestBuffer 313 log4perl.appender.Buffer1.layout = PatternLayout 314 log4perl.appender.Buffer1.layout.ConversionPattern=meth=%M %m %n 315 316 # 2nd TestBuffer appender 317 log4perl.appender.Buffer2 = Log::Log4perl::Appender::TestBuffer 318 log4perl.appender.Buffer2.layout = PatternLayout 319 log4perl.appender.Buffer2.layout.ConversionPattern=meth=%M %m %n 320 321 # Composite Appender 322 log4perl.appender.Composite = Log::Log4perl::Appender::Buffer 323 log4perl.appender.Composite.appender = Buffer2 324 log4perl.appender.Composite.trigger = sub { 1 } 325); 326 327Log::Log4perl->init(\$conf); 328 329my $buffer1 = Log::Log4perl::Appender::TestBuffer->by_name("Buffer1"); 330my $buffer2 = Log::Log4perl::Appender::TestBuffer->by_name("Buffer2"); 331 332$logger = get_logger(); 333 334$logger->warn("Sent from main"); 335 336Willy::Wonka::func(); 337 338like $buffer1->buffer(), 339 qr/meth=main:: Sent from main.*meth=Willy::Wonka::func Sent from func/s, 340 "caller stack from direct appender"; 341like $buffer2->buffer(), 342 qr/meth=main:: Sent from main.*meth=Willy::Wonka::func Sent from func/s, 343 "caller stack from composite appender"; 344 345# [RT 72056] Appender Threshold blocks composite appender 346 347$conf = qq( 348 log4perl.category = DEBUG, Composite 349 350 log4perl.appender.Buffer = Log::Log4perl::Appender::TestBuffer 351 log4perl.appender.Buffer.layout = PatternLayout 352 log4perl.appender.Buffer.Threshold=INFO 353 log4perl.appender.Buffer.layout.ConversionPattern=%M %m %n 354 355 # Composite Appender 356 log4perl.appender.Composite = Log::Log4perl::Appender::Buffer 357 log4perl.appender.Composite.appender = Buffer 358 log4perl.appender.Composite.trigger = sub { 0 } 359 360); 361 362Log::Log4perl->init(\$conf); 363 364$buffer = Log::Log4perl::Appender::TestBuffer->by_name("Buffer"); 365$logger = get_logger(); 366$logger->debug("this will be blocked by the appender threshold"); 367 368my $composite = Log::Log4perl->appender_by_name("Composite"); 369$composite->flush(); 370 371is $buffer->buffer(), "", 372 "appender threshold blocks message in composite appender"; 373