1########################################### 2# Test Suite for 'Buffer' appender 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 tests => 6; 17use Log::Log4perl::Appender::TestBuffer; 18 19use Log::Log4perl qw(:easy); 20 21my $conf = q( 22log4perl.category = DEBUG, Buffer 23log4perl.category.triggertest = DEBUG, Buffer2 24 25 # Regular Screen Appender 26log4perl.appender.Screen = Log::Log4perl::Appender::TestBuffer 27log4perl.appender.Screen.layout = PatternLayout 28log4perl.appender.Screen.layout.ConversionPattern = %d %p %c %m %n 29 30 # Buffering appender, using the appender above as outlet 31log4perl.appender.Buffer = Log::Log4perl::Appender::Buffer 32log4perl.appender.Buffer.appender = Screen 33log4perl.appender.Buffer.trigger_level = ERROR 34 35 # Second Screen Appender 36log4perl.appender.Screen2 = Log::Log4perl::Appender::TestBuffer 37log4perl.appender.Screen2.layout = PatternLayout 38log4perl.appender.Screen2.layout.ConversionPattern = %d %p %c %m %n 39 40 # Buffering appender, with a subroutine reference as a trigger 41log4perl.appender.Buffer2 = Log::Log4perl::Appender::Buffer 42log4perl.appender.Buffer2.appender = Screen2 43log4perl.appender.Buffer2.trigger = sub { \ 44 my($self, $params) = @_; \ 45 return Log::Log4perl::Level::to_priority($params->{log4p_level}) >= \ 46 Log::Log4perl::Level::to_priority('ERROR') } 47 48); 49 50Log::Log4perl->init(\$conf); 51 52my $buf = Log::Log4perl::Appender::TestBuffer->by_name("Screen"); 53 54DEBUG("This message gets buffered."); 55is($buf->buffer(), "", "Buffering DEBUG"); 56 57INFO("This message gets buffered also."); 58is($buf->buffer(), "", "Buffering INFO"); 59 60ERROR("This message triggers a buffer flush."); 61like($buf->buffer(), qr/DEBUG.*?INFO.*?ERROR/s, "Flushing ERROR"); 62 63 64# testing trigger sub 65 66my $buf2 = Log::Log4perl::Appender::TestBuffer->by_name("Screen2"); 67 68my $logger = Log::Log4perl->get_logger('triggertest'); 69$logger->debug("This message gets buffered."); 70is($buf2->buffer(), "", "Buffering DEBUG"); 71 72$logger->info("This message gets buffered also."); 73is($buf2->buffer(), "", "Buffering INFO"); 74 75$logger->error("This message triggers a buffer flush."); 76like($buf2->buffer(), qr/DEBUG.*?INFO.*?ERROR/s, "Flushing ERROR"); 77