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