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