1###########################################
2# Test Suite for Log::Log4perl
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
13#########################
14# change 'tests => 1' to 'tests => last_test_to_print';
15#########################
16use Test::More;
17BEGIN { plan tests => 26 };
18
19use Log::Log4perl;
20use Log::Log4perl::Appender::TestBuffer;
21use File::Spec;
22
23my $EG_DIR = "eg";
24$EG_DIR = "../eg" unless -d $EG_DIR;
25
26my $TMP_FILE = File::Spec->catfile($EG_DIR, "warnings");
27
28ok(1, "Startup"); # If we made it this far, we are ok.
29
30######################################################################
31# Test the root logger on a configuration file defining a file appender
32######################################################################
33Log::Log4perl->init("$EG_DIR/log4j-manual-1.conf");
34
35my $logger = Log::Log4perl->get_logger("");
36$logger->debug("Gurgel");
37
38
39like(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(), 
40   qr#^\d+\s+\[N/A\] DEBUG  N/A - Gurgel$#, "Root logger"); 
41
42######################################################################
43# Test the root logger via inheritance (discovered by Kevin Goess)
44######################################################################
45Log::Log4perl::Appender::TestBuffer->reset();
46
47Log::Log4perl->init("$EG_DIR/log4j-manual-1.conf");
48
49$logger = Log::Log4perl->get_logger("foo");
50$logger->debug("Gurgel");
51
52like(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(),
53    qr#^\d+\s+\[N/A\] DEBUG foo N/A - Gurgel$#, "Root logger inherited"); 
54
55######################################################################
56# Test init with a string
57######################################################################
58Log::Log4perl::Appender::TestBuffer->reset();
59
60Log::Log4perl->init(\ <<EOT);
61log4j.rootLogger=DEBUG, A1
62log4j.appender.A1=Log::Log4perl::Appender::TestBuffer
63log4j.appender.A1.layout=org.apache.log4j.PatternLayout
64log4j.appender.A1.layout.ConversionPattern=%-4r [%t] %-5p %c - %m%n
65EOT
66
67$logger = Log::Log4perl->get_logger("foo");
68$logger->debug("Gurgel");
69
70like(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(),
71    qr#^\d+\s+\[N/A\] DEBUG foo - Gurgel$#, "Init via string"); 
72
73######################################################################
74# Test init with a hashref
75######################################################################
76Log::Log4perl::Appender::TestBuffer->reset();
77
78my %hash = (
79    "log4j.rootLogger"         => "DEBUG, A1",
80    "log4j.appender.A1"        => "Log::Log4perl::Appender::TestBuffer",
81    "log4j.appender.A1.layout" => "org.apache.log4j.PatternLayout",
82    "log4j.appender.A1.layout.ConversionPattern" => 
83                                  "%-4r [%t] %-5p %c - %m%n"
84    );
85
86Log::Log4perl->init(\%hash);
87
88$logger = Log::Log4perl->get_logger("foo");
89$logger->debug("Gurgel");
90
91like(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(),
92    qr#^\d+\s+\[N/A\] DEBUG foo - Gurgel$#, "Init via hashref"); 
93
94
95############################################################
96# testing multiple parameters, nested hashes
97############################################################
98
99our $stub_hook;
100
101# -----------------------------------
102# here is a stub
103package Log::Log4perl::AppenderTester;
104sub new {
105    my($class, %params) = @_;
106    my $self = {};
107    bless $self, $class;
108
109    $self->{P} = \%params;
110
111    $main::stub_hook = $self;
112    
113    return $self;
114}
115package main;
116# -----------------------------------
117
118Log::Log4perl->init(\ <<'EOT');
119#here is an example of using Log::Dispatch::Jabber
120
121log4j.category.animal.dog   = INFO, jabbender
122
123log4j.appender.jabbender          = Log::Log4perl::AppenderTester
124log4j.appender.jabbender.layout   = Log::Log4perl::Layout::SimpleLayout
125log4j.appender.jabbender.login.hostname = a.jabber.server
126log4j.appender.jabbender.login.port = 5222
127log4j.appender.jabbender.login.username =  bugs
128log4j.appender.jabbender.login.password = bunny
129log4j.appender.jabbender.login.resource = logger
130log4j.appender.jabbender.to = elmer@a.jabber.server
131log4j.appender.jabbender.to = sam@another.jabber.server
132
133EOT
134
135#should produce this:
136#{
137#    login => {
138#          hostname => "a.jabber.server",
139#          password => "bunny",
140#          port     => 5222,
141#          resource => "logger",
142#          username => "bugs",
143#        },
144#    to => ["elmer\@a.jabber.server", "sam\@another.jabber.server"],
145#  },
146
147
148is($stub_hook->{P}{login}{hostname}, 'a.jabber.server', "Config and Jabber");
149is($stub_hook->{P}{login}{password}, 'bunny', "Config and Jabber");
150is($stub_hook->{P}{to}[0], 'elmer@a.jabber.server', "Config and Jabber");
151is($stub_hook->{P}{to}[1], 'sam@another.jabber.server', "Config and Jabber");
152
153##########################################################################
154# Test what happens if we define a PatternLayout without ConversionPattern
155##########################################################################
156Log::Log4perl::Appender::TestBuffer->reset();
157
158$conf = <<EOT;
159    log4perl.logger.Twix.Bar = DEBUG, A1
160    log4perl.appender.A1=Log::Log4perl::Appender::TestBuffer
161    log4perl.appender.A1.layout=PatternLayout
162    #log4perl.appender.A1.layout.ConversionPattern=%d-%c %m%n
163EOT
164
165eval { Log::Log4perl->init(\$conf); };
166
167
168#actually, it turns out that log4j handles this, if no ConversionPattern
169#specified is uses DEFAULT_LAYOUT_PATTERN, %m%n
170#ok($@, '/No ConversionPattern given for PatternLayout/'); 
171is($@, '', 'PatternLayout without ConversionPattern'); 
172
173######################################################################
174# Test with $/ set to undef
175######################################################################
176$/ = undef;
177Log::Log4perl->init("$EG_DIR/log4j-manual-1.conf");
178
179$logger = Log::Log4perl->get_logger("");
180$logger->debug("Gurgel");
181
182like(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(), 
183     qr#^\d+\s+\[N/A\] DEBUG  N/A - Gurgel$#, "Config in slurp mode"); 
184
185######################################################################
186# Test init with a config parser object
187######################################################################
188Log::Log4perl::Appender::TestBuffer->reset();
189
190my $parser = Log::Log4perl::Config::PropertyConfigurator->new();
191my @lines = split "\n", <<EOT;
192log4j.rootLogger         = DEBUG, A1
193log4j.appender.A1        = Log::Log4perl::Appender::TestBuffer
194log4j.appender.A1.layout = org.apache.log4j.PatternLayout
195log4j.appender.A1.layout.ConversionPattern = object%m%n
196EOT
197$parser->text(\@lines);
198
199Log::Log4perl->init($parser);
200
201$logger = Log::Log4perl->get_logger("foo");
202$logger->debug("Gurgel");
203
204is(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(), 
205   "objectGurgel\n", "Init with parser object"); 
206
207######################################################################
208# Test integrity check
209######################################################################
210open STDERR, ">$TMP_FILE";
211open IN, "<$TMP_FILE" or die "Cannot open $TMP_FILE";
212sub readwarn { return (scalar <IN>) || ''; }
213END { close IN }
214
215Log::Log4perl->init(\ <<EOT);
216    # Just an empty configuration
217EOT
218
219like(readwarn(), qr/looks suspicious: No loggers/, 
220     "Test integrity check on empty conf file");
221
222close STDERR;
223close IN;
224unlink $TMP_FILE;
225
226######################################################################
227# Misspelled 'rootlogger' (needs to be rootLogger)
228######################################################################
229open STDERR, ">$TMP_FILE";
230open IN, "<$TMP_FILE" or die "Cannot open $TMP_FILE";
231
232Log::Log4perl->reset();
233$Log::Log4perl::Logger::LOGGERS_BY_NAME = {};
234
235Log::Log4perl->init(\ <<EOT);
236  log4perl.rootlogger=ERROR, LOGFILE
237
238  log4perl.appender.LOGFILE=Log::Log4perl::Appender::Screen
239  log4perl.appender.LOGFILE.layout=PatternLayout
240  log4perl.appender.LOGFILE.layout.ConversionPattern=[%r] %F %L %c - %m %n
241EOT
242
243is(readwarn(), "", "Autocorrecting rootLogger/rootlogger typo");
244
245close STDERR;
246close IN;
247unlink $TMP_FILE;
248
249######################################################################
250# Totally misspelled rootLogger
251######################################################################
252open STDERR, ">$TMP_FILE";
253open IN, "<$TMP_FILE" or die "Cannot open $TMP_FILE";
254
255Log::Log4perl->reset();
256$Log::Log4perl::Logger::LOGGERS_BY_NAME = {};
257
258Log::Log4perl->init(\ <<EOT);
259  log4perl.schtonk=ERROR, LOGFILE
260
261  log4perl.appender.LOGFILE=Log::Log4perl::Appender::Screen
262  log4perl.appender.LOGFILE.layout=PatternLayout
263  log4perl.appender.LOGFILE.layout.ConversionPattern=[%r] %F %L %c - %m %n
264EOT
265
266like(readwarn(), qr/looks suspicious: No loggers/, 
267     "Test integrity check on totally misspelled rootLogger typo");
268
269close STDERR;
270close IN;
271unlink $TMP_FILE;
272
273######################################################################
274# PatternLayout %m{}
275######################################################################
276Log::Log4perl::Appender::TestBuffer->reset();
277
278Log::Log4perl->init(\ <<EOT);
279log4j.logger.foo=DEBUG, A1
280log4j.appender.A1=Log::Log4perl::Appender::TestBuffer
281log4j.appender.A1.layout=org.apache.log4j.PatternLayout
282log4j.appender.A1.layout.ConversionPattern=%M%m
283EOT
284
285###########################################
286sub somefunc {
287###########################################
288    $logger = Log::Log4perl->get_logger("foo");
289    $logger->debug("Gurgel");
290}
291
292package SomePackage;
293###########################################
294sub somepackagefunc {
295###########################################
296    $logger = Log::Log4perl->get_logger("foo");
297    $logger->debug("Gurgel");
298}
299package main;
300
301somefunc();
302is(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(),
303        "main::somefuncGurgel", "%M main");
304
305Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer("");
306SomePackage::somepackagefunc();
307is(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(), 
308        "SomePackage::somepackagefuncGurgel", "%M in package");
309
310######################################################################
311# PatternLayout %m{1}
312######################################################################
313Log::Log4perl::Appender::TestBuffer->reset();
314
315Log::Log4perl->init(\ <<EOT);
316log4j.logger.foo=DEBUG, A1
317log4j.appender.A1=Log::Log4perl::Appender::TestBuffer
318log4j.appender.A1.layout=org.apache.log4j.PatternLayout
319log4j.appender.A1.layout.ConversionPattern=%M{1}%m
320EOT
321
322somefunc();
323is(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(),
324        "somefuncGurgel", "%M{1} main");
325
326Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer("");
327SomePackage::somepackagefunc();
328is(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(), 
329        "somepackagefuncGurgel", "%M{1} package");
330
331######################################################################
332# PatternLayout %p{1}
333######################################################################
334Log::Log4perl::Appender::TestBuffer->reset();
335
336Log::Log4perl->init(\ <<EOT);
337log4j.logger.foo=DEBUG, A1
338log4j.appender.A1=Log::Log4perl::Appender::TestBuffer
339log4j.appender.A1.layout=org.apache.log4j.PatternLayout
340log4j.appender.A1.layout.ConversionPattern=-%p{1}- %m
341EOT
342
343somefunc();
344is(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(),
345        "-D- Gurgel", "%p{1} main");
346
347Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer("");
348SomePackage::somepackagefunc();
349is(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(), 
350        "-D- Gurgel", "%p{1} package");
351
352######################################################################
353# Test accessors
354######################################################################
355$parser = Log::Log4perl::Config::PropertyConfigurator->new();
356@lines = split "\n", <<EOT;
357log4j.rootLogger         = DEBUG, A1
358log4j.appender.A1        = Log::Log4perl::Appender::TestBuffer
359log4j.appender.A1.layout = org.apache.log4j.PatternLayout
360log4j.appender.A1.layout.ConversionPattern = object%m%n
361EOT
362$parser->text(\@lines);
363$parser->parse();
364is($parser->value("log4j.rootLogger"), "DEBUG, A1", "value() accessor");
365is($parser->value("log4j.foobar"), undef, "value() accessor undef");
366
367is($parser->value("log4j.appender.A1"), 
368   "Log::Log4perl::Appender::TestBuffer", "value() accessor");
369
370is($parser->value("log4perl.appender.A1.layout.ConversionPattern"), 
371   "object%m%n", "value() accessor log4perl");
372
373######################################################################
374# Test accessors
375######################################################################
376my $conf = q{
377log4perl.category.pf.trigger = DEBUG
378log4j.appender.A1        = Log::Log4perl::Appender::TestBuffer
379log4j.appender.A1.layout = org.apache.log4j.PatternLayout
380log4j.appender.A1.layout.ConversionPattern = object%m%n
381};
382
383eval { Log::Log4perl->init( \$conf ); };
384
385is $@, "", "'trigger' category [rt.cpan.org #50495]";
386