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