1###########################################
2# Test Suite for Log::Log4perl::Logger
3# Mike Schilli, 2002 (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
18use Log::Log4perl qw(get_logger);
19use Log::Log4perl::Level;
20
21BEGIN { plan tests => 24 }
22
23ok(1); # If we made it this far, we're ok.
24
25cmp_ok(Log::Log4perl->appender_thresholds_adjust(1), q{==}, 0,
26    q{Expect 0 appenders to be affected before first init since there are none}
27);
28
29my $log0 =  Log::Log4perl->get_logger("");
30my $log1 = Log::Log4perl->get_logger("abc.def");
31my $log2 = Log::Log4perl->get_logger("abc.def.ghi");
32
33$log0->level($DEBUG);
34$log1->level($DEBUG);
35$log2->level($DEBUG);
36
37my $app0 = Log::Log4perl::Appender->new(
38    "Log::Log4perl::Appender::TestBuffer");
39
40my $app1 = Log::Log4perl::Appender->new(
41    "Log::Log4perl::Appender::TestBuffer");
42
43$app0->threshold($ERROR);  # As integer value
44$app1->threshold("WARN");  # As string
45
46$log0->add_appender($app0);
47$log1->add_appender($app1);
48
49##################################################
50# Root logger's appender
51##################################################
52$app0->buffer("");
53$app1->buffer("");
54$log0->warn("Don't want to see this");
55$log0->error("Yeah, log0");
56
57is($app0->buffer(), "ERROR - Yeah, log0\n", "Threshold ERROR");
58is($app1->buffer(), "", "Threshold WARN");
59
60##################################################
61# Inherited appender
62##################################################
63my $ret;
64
65$app0->buffer("");
66$app1->buffer("");
67
68$ret = $log1->info("Don't want to see this");
69is($ret, 0, "Info suppressed");
70
71$ret = $log1->warn("Yeah, log1");
72is($ret, 1, "inherited");
73
74is($app0->buffer(), "", "inherited");
75is($app1->buffer(), "WARN - Yeah, log1\n", "inherited");
76
77##################################################
78# Inherited appender over two hierarchies
79##################################################
80$app0->buffer("");
81$app1->buffer("");
82$log2->info("Don't want to see this");
83$log2->error("Yeah, log2");
84
85is($app0->buffer(), "ERROR - Yeah, log2\n", "two hierarchies");
86is($app1->buffer(), "ERROR - Yeah, log2\n", "two hierarchies");
87
88##################################################
89# Appender threshold with config file
90##################################################
91# Reset appender population
92Log::Log4perl::Appender::TestBuffer->reset();
93
94my $conf = <<EOT;
95log4perl.logger   = ERROR, BUF0
96log4perl.logger.a = INFO, BUF1
97log4perl.appender.BUF0           = Log::Log4perl::Appender::TestBuffer
98log4perl.appender.BUF0.layout    = Log::Log4perl::Layout::SimpleLayout
99log4perl.appender.BUF0.Threshold = ERROR
100log4perl.appender.BUF1           = Log::Log4perl::Appender::TestBuffer
101log4perl.appender.BUF1.layout    = Log::Log4perl::Layout::SimpleLayout
102log4perl.appender.BUF1.Threshold = WARN
103EOT
104
105Log::Log4perl::init(\$conf);
106
107$app0 = Log::Log4perl::Appender::TestBuffer->by_name("BUF0");
108$app1 = Log::Log4perl::Appender::TestBuffer->by_name("BUF1");
109
110my $loga = get_logger("a");
111
112$loga->info("Don't want to see this");
113$loga->error("Yeah, loga");
114
115is($app0->buffer(), "ERROR - Yeah, loga\n", "appender threshold");
116is($app1->buffer(), "ERROR - Yeah, loga\n", "appender threshold");
117
118##################################################
119# Appender threshold with config file and a Java
120# Class
121##################################################
122# Reset appender population
123Log::Log4perl::Appender::TestBuffer->reset();
124
125$conf = <<EOT;
126log4j.logger   = ERROR, BUF0
127log4j.logger.a = INFO, BUF1
128log4j.appender.BUF0           = org.apache.log4j.TestBuffer
129log4j.appender.BUF0.layout    = SimpleLayout
130log4j.appender.BUF0.Threshold = ERROR
131log4j.appender.BUF1           = org.apache.log4j.TestBuffer
132log4j.appender.BUF1.layout    = SimpleLayout
133log4j.appender.BUF1.Threshold = WARN
134EOT
135
136Log::Log4perl::init(\$conf);
137
138$app0 = Log::Log4perl::Appender::TestBuffer->by_name("BUF0");
139$app1 = Log::Log4perl::Appender::TestBuffer->by_name("BUF1");
140
141$loga = get_logger("a");
142
143$loga->info("Don't want to see this");
144$loga->error("Yeah, loga");
145
146is($app0->buffer(), "ERROR - Yeah, loga\n", "threshold/java");
147is($app1->buffer(), "ERROR - Yeah, loga\n", "threshold/java");
148
149##################################################
150# 'threshold' vs. 'Threshold'
151##################################################
152$conf = <<EOT;
153log4j.logger   = ERROR, BUF0
154log4j.logger.a = INFO, BUF1
155log4j.appender.BUF0           = org.apache.log4j.TestBuffer
156log4j.appender.BUF0.layout    = SimpleLayout
157log4j.appender.BUF0.Threshold = ERROR
158log4j.appender.BUF1           = org.apache.log4j.TestBuffer
159log4j.appender.BUF1.layout    = SimpleLayout
160log4j.appender.BUF1.threshold = WARN
161EOT
162
163eval { Log::Log4perl::init(\$conf); };
164
165if($@) {
166    like($@, qr/perhaps you meant 'Threshold'/, 
167         "warn on misspelled 'threshold'");
168} else {
169    ok(0, "Abort on misspelled 'threshold'");
170}
171
172##################################################
173# Increase threshold of all appenders
174##################################################
175$conf = <<EOT;
176log4perl.category                 = WARN, BUF0, BUF1
177
178log4perl.appender.BUF0            = Log::Log4perl::Appender::TestBuffer
179log4perl.appender.BUF0.Threshold  = WARN
180log4perl.appender.BUF0.layout     = SimpleLayout
181
182log4perl.appender.BUF1            = Log::Log4perl::Appender::TestBuffer
183log4perl.appender.BUF1.Threshold  = ERROR
184log4perl.appender.BUF1.layout     = SimpleLayout
185EOT
186
187Log::Log4perl::init(\$conf);
188
189$app0 = Log::Log4perl::Appender::TestBuffer->by_name("BUF0");
190$app1 = Log::Log4perl::Appender::TestBuffer->by_name("BUF1");
191
192my $logger = get_logger("");
193
194$logger->info("Info");
195$logger->warn("Warning");
196$logger->error("Error");
197
198is($app0->buffer(), "WARN - Warning\nERROR - Error\n", "appender threshold");
199is($app1->buffer(), "ERROR - Error\n", "appender threshold");
200
201cmp_ok(Log::Log4perl->appender_thresholds_adjust(-1),
202    q{==}, 2, q{Expect 2 appenders to be affected});
203
204$app0->buffer("");
205$app1->buffer("");
206
207$logger->more_logging();
208$logger->info("Info");
209$logger->warn("Warning");
210$logger->error("Error");
211
212is($app0->buffer(), "INFO - Info\nWARN - Warning\nERROR - Error\n", 
213                    "adjusted appender threshold");
214is($app1->buffer(), "WARN - Warning\nERROR - Error\n", 
215                    "appender threshold");
216
217$app0->buffer("");
218$app1->buffer("");
219
220   # reset previous thresholds
221cmp_ok(Log::Log4perl->appender_thresholds_adjust(1),
222    q{==}, 2, q{Expect 2 appenders to be affected});
223
224$app0->buffer("");
225$app1->buffer("");
226
227   # rig just one threshold
228cmp_ok(Log::Log4perl->appender_thresholds_adjust(-1, ['BUF0']),
229    q{==}, 1, q{Expect 1 appender to be affected});
230
231$logger->more_logging();
232$logger->info("Info");
233$logger->warn("Warning");
234$logger->error("Error");
235
236is($app0->buffer(), "INFO - Info\nWARN - Warning\nERROR - Error\n", 
237                    "adjusted appender threshold");
238is($app1->buffer(), "ERROR - Error\n", 
239                    "appender threshold");
240
241