1#testing init_and_watch
2#special problem with init_and_watch,
3#fixed in Logger::reset by setting logger level to OFF
4
5BEGIN { 
6    if($ENV{INTERNAL_DEBUG}) {
7        require Log::Log4perl::InternalDebug;
8        Log::Log4perl::InternalDebug->enable();
9    }
10}
11
12use Test::More;
13
14use warnings;
15use strict;
16
17use Log::Log4perl qw(:easy);
18use Log::Log4perl::Appender::TestBuffer;
19use File::Spec;
20
21BEGIN {
22    if ($] < 5.006) {
23        plan skip_all => "Only with perl >= 5.006";
24    } else {
25        plan tests => 21;
26    }
27}
28
29my $WORK_DIR = "tmp";
30if(-d "t") {
31    $WORK_DIR = "t/tmp";
32}
33unless (-e "$WORK_DIR"){
34    mkdir("$WORK_DIR", 0755) || die "can't create $WORK_DIR ($!)";
35}
36
37my $testconf= "$WORK_DIR/test27.conf";
38unlink $testconf if (-e $testconf);
39
40#goto NEW;
41Log::Log4perl::Appender::TestBuffer->reset();
42
43my $conf1 = <<EOL;
44log4j.category   = WARN, myAppender
45
46log4j.appender.myAppender          = Log::Log4perl::Appender::TestBuffer
47log4j.appender.myAppender.layout   = Log::Log4perl::Layout::SimpleLayout
48
49log4j.category.animal.dog = DEBUG, goneAppender
50
51log4j.appender.goneAppender          = Log::Log4perl::Appender::TestBuffer
52log4j.appender.goneAppender.layout   = Log::Log4perl::Layout::SimpleLayout
53
54log4j.category.animal.cat = INFO, myAppender
55
56EOL
57open (CONF, ">$testconf") || die "can't open $testconf $!";
58print CONF $conf1;
59close CONF;
60
61
62Log::Log4perl->init_and_watch($testconf, 1);
63
64my $logger = Log::Log4perl::get_logger('animal.dog');
65
66ok(  $logger->is_debug(), "is_debug - true");
67ok(  $logger->is_info(),  "is_info - true");
68ok(  $logger->is_warn(),  "is_warn - true");
69ok(  $logger->is_error(), "is_error - true");
70ok(  $logger->is_fatal(), "is_fatal - true");
71
72my $app0 = Log::Log4perl::Appender::TestBuffer->by_name("myAppender");
73
74$logger->debug('debug message, should appear');
75
76is($app0->buffer(), "DEBUG - debug message, should appear\n");
77
78
79#---------------------------
80#now go to sleep and reload
81
82print "sleeping for 3 seconds\n";
83sleep 3;
84
85$conf1 = <<EOL;
86log4j.category   = WARN, myAppender
87
88log4j.appender.myAppender          = Log::Log4perl::Appender::TestBuffer
89log4j.appender.myAppender.layout   = Log::Log4perl::Layout::SimpleLayout
90
91#*****log4j.category.animal.dog = DEBUG, goneAppender
92
93#*****log4j.appender.goneAppender          = Log::Log4perl::Appender::TestBuffer
94#*****log4j.appender.goneAppender.layout   = Log::Log4perl::Layout::SimpleLayout
95
96log4j.category.animal.cat = INFO, myAppender
97
98EOL
99open (CONF, ">$testconf") || die "can't open $testconf $!";
100print CONF $conf1;
101close CONF;
102
103ok(! $logger->is_debug(), "is_debug - false");
104ok(! $logger->is_info(),  "is_info - false");
105ok(  $logger->is_warn(),  "is_warn - true");
106ok(  $logger->is_error(), "is_error - true");
107ok(  $logger->is_fatal(), "is_fatal - true");
108
109#now the logger is ruled by root/s WARN level
110$logger->debug('debug message, should NOT appear');
111
112my $app1 = Log::Log4perl::Appender::TestBuffer->by_name("myAppender");
113
114is($app1->buffer(), "", "buffer empty");
115
116$logger->warn('warning message, should appear');
117
118is($app1->buffer(), "WARN - warning message, should appear\n", "warn in");
119
120#check the root logger
121$logger = Log::Log4perl::get_logger();
122
123$logger->warn('warning message, should appear');
124
125like($app1->buffer(), qr/(WARN - warning message, should appear\n){2}/,
126     "2nd warn in");
127
128# -------------------------------------------
129#double-check an unrelated category with a lower level
130$logger = Log::Log4perl::get_logger('animal.cat');
131$logger->info('warning message to cat, should appear');
132
133like($app1->buffer(), qr/(WARN - warning message, should appear\n){2}INFO - warning message to cat, should appear/, "message output");
134
135NEW:
136############################################################################
137# This was a bug in L4p 1.01: After init_and_watch() caused a re-init,
138# filename/linenumber were referring to 'eval', not the actual file
139# name/line number of the message.
140
141my $counter = 0;
142my $reload_permitted = 1;
143conf_file_write();
144Log::Log4perl->init_and_watch($testconf, 1, { 
145    preinit_callback => sub { 
146        $counter++;
147#print "Counter incremented to $counter\n";
148        return $reload_permitted;
149    },
150});
151
152
153my $line_ref = __LINE__ + 1;
154DEBUG("first");
155  my $buf = Log::Log4perl::Appender::TestBuffer->by_name("Testbuffer");
156  like($buf->buffer(), qr/027Watch2.t $line_ref> first/, 
157       "init-and-watch caller level first");
158  $buf->buffer("");
159
160print "Sleeping 1 second\n";
161sleep(1);
162conf_file_write();
163$line_ref = __LINE__ + 1;
164DEBUG("second");
165  $buf = Log::Log4perl::Appender::TestBuffer->by_name("Testbuffer");
166  like($buf->buffer(), qr/027Watch2.t $line_ref> second/,
167       "init-and-watch caller level second");
168  $buf->buffer("");
169
170$reload_permitted = 0;
171print "Sleeping 2 seconds\n";
172sleep(2);
173conf_file_write("FATAL");
174$line_ref = __LINE__ + 1;
175DEBUG("third");
176  $buf = Log::Log4perl::Appender::TestBuffer->by_name("Testbuffer");
177  like($buf->buffer(), qr/027Watch2.t $line_ref> third/,
178       "init-and-watch caller level third");
179  $buf->buffer("");
180
181$reload_permitted = 1;
182print "Sleeping 2 seconds\n";
183sleep(2);
184conf_file_write("ERROR");
185$line_ref = __LINE__ + 1;
186ERROR("third");
187  $buf = Log::Log4perl::Appender::TestBuffer->by_name("Testbuffer");
188  like($buf->buffer(), qr/027Watch2.t $line_ref> third/,
189       "init-and-watch caller level third");
190  $buf->buffer("");
191
192ok($counter >= 1, "Callback counter check");
193
194print "Sleeping 2 seconds\n";
195sleep(2);
196ERROR("fourth");
197like $buf->buffer(), qr/main-main:: 027Watch2.t/, 
198     "[rt.cpan.org #60386] caller level check";
199
200###########################################
201sub conf_file_write {
202###########################################
203    my($level) = @_;
204
205    $level = "DEBUG" unless defined $level;
206
207    open FILE, ">$testconf" or die $!;
208    print FILE <<EOT;
209log4perl.category.main = $level, Testbuffer
210log4perl.appender.Testbuffer        = Log::Log4perl::Appender::TestBuffer
211log4perl.appender.Testbuffer.layout = Log::Log4perl::Layout::PatternLayout
212log4perl.appender.Testbuffer.layout.ConversionPattern = %d %C-%M %F{1} %L> %m %n
213EOT
214    close FILE;
215#print "Config written\n";
216}
217
218unlink $testconf;
219