1########################################### 2# Test Suite for Log::Log4perl::Config 3# Erik Selberg, (c) 2002 erik@selberg.com 4# clone of 025CustLevels.t but uses nicer method (?) we hope 5########################################### 6 7BEGIN { 8 if($ENV{INTERNAL_DEBUG}) { 9 require Log::Log4perl::InternalDebug; 10 Log::Log4perl::InternalDebug->enable(); 11 } 12} 13 14######################### 15# change 'tests => 1' to 'tests => last_test_to_print'; 16######################### 17use Test; 18 19#create a custom level "LITEWARN" 20use Log::Log4perl; 21use Log::Log4perl::Level; 22use Log::Log4perl::Appender::TestBuffer; 23# use strict; 24 25 26ok(1); # If we made it this far, we're ok. 27 28Log::Log4perl::Logger::create_custom_level("LITEWARN", "WARN"); 29#testing for bugfix of 9/19/03 before which custom levels beneath DEBUG didn't work 30Log::Log4perl::Logger::create_custom_level("DEBUG2", "DEBUG"); 31 32# test insane creation of levels 33 34foreach (1 .. 14) { 35 ok(Log::Log4perl::Logger::create_custom_level("TEST$_", "INFO"), 0); 36} 37 38# 15th should fail.. this assumes that each level is 10000 apart from 39# the other. 40 41ok(!defined eval { Log::Log4perl::Logger::create_custom_level("TEST15", "INFO") }); 42 43# now, by re-arranging (as we whine about in create_custom_levels), we 44# should be able to get 15. 45 46my %btree = ( 47 8 => "DEBUG", 48 4 => 8, 49 2 => 4, 50 1 => 2, 51 3 => 4, 52 6 => 8, 53 5 => 6, 54 7 => 8, 55 12 => "DEBUG", 56 10 => 12, 57 9 => 10, 58 11 => 12, 59 14 => "DEBUG", 60 13 => 14, 61 15 => "DEBUG", 62 ); 63 64foreach (8, 4, 2, 1, 3, 6, 5, 7, 12, 10, 9, 11, 14, 13, 15) { 65 my $level = $btree{$_} eq "DEBUG" ? "DEBUG" : "BTREE$btree{$_}"; 66# warn("Creating BTREE$_ after $level"); 67 ok(Log::Log4perl::Logger::create_custom_level("BTREE$_", $level), 0); 68# warn("BTREE$_ is ", ${Log::Log4perl::Level::PRIORITY{"BTREE$_"}}); 69} 70 71# foreach (1 .. 15) { 72# warn("BTREE$_ is: ", ${Log::Log4perl::Level::PRIORITY{"BTREE$_"}}); 73# } 74 75 76my $LOGFILE = "example.log"; 77unlink $LOGFILE; 78 79my $config = <<EOT; 80log4j.category = LITEWARN, FileAppndr 81log4j.appender.FileAppndr = Log::Log4perl::Appender::File 82log4j.appender.FileAppndr.filename = $LOGFILE 83log4j.appender.FileAppndr.layout = Log::Log4perl::Layout::SimpleLayout 84 85log4j.category.debug2test = DEBUG2, FileAppndr 86log4j.additivity.debug2test= 0 87EOT 88 89 90Log::Log4perl::init(\$config); 91 92 93# can't create a custom level after init... let's test that. Just look 94# for an undef (i.e. failure) from the eval 95 96ok(!defined eval { Log::Log4perl::Logger::create_custom_level("NOTIFY", "WARN"); }); 97 98 99# ********************* 100# check a category logger 101 102my $logger = Log::Log4perl->get_logger("groceries.beer"); 103$logger->warn("this is a warning message"); 104$logger->litewarn("this is a LITE warning message (2/3 the calories)"); 105$logger->info("this info message should not log"); 106 107 108open FILE, "<$LOGFILE" or die "Cannot open $LOGFILE"; 109$/ = undef; 110my $data = <FILE>; 111close FILE; 112my $result1 = "WARN - this is a warning message\nLITEWARN - this is a LITE warning message (2/3 the calories)\n"; 113ok($data, $result1); 114 115# ********************* 116# check the root logger 117my $rootlogger = Log::Log4perl->get_logger(""); 118$logger->warn("this is a rootlevel warning message"); 119$logger->litewarn("this is a rootlevel LITE warning message (2/3 the calories)"); 120$logger->info("this rootlevel info message should not log"); 121 122open FILE, "<$LOGFILE" or die "Cannot open $LOGFILE"; 123$/ = undef; 124$data = <FILE>; 125close FILE; 126my $result2 = "WARN - this is a rootlevel warning message\nLITEWARN - this is a rootlevel LITE warning message (2/3 the calories)\n"; 127ok($data, "$result1$result2"); 128 129$logger->log($WARN, "a warning message"); 130$logger->log($LITEWARN, "a LITE warning message"); 131die("lame hack to suppress warning") if ($LITEWARN != $LITEWARN); 132$logger->log($DEBUG, "an info message, should not log"); 133 134open FILE, "<$LOGFILE" or die "Cannot open $LOGFILE"; 135$/ = undef; 136$data = <FILE>; 137close FILE; 138my $result3 = "WARN - a warning message\nLITEWARN - a LITE warning message\n"; 139ok($data, "$result1$result2$result3"); 140 141# ********************* 142# check debug2 level 143my $debug2 = Log::Log4perl->get_logger("debug2test"); 144$debug2->debug2("this is a debug2 message"); 145 146open FILE, "<$LOGFILE" or die "Cannot open $LOGFILE"; 147$/ = undef; 148$data = <FILE>; 149close FILE; 150my $result4 = "DEBUG2 - this is a debug2 message\n"; 151ok($data, "$result1$result2$result3$result4"); 152 153#********************* 154#check the is_* methods 155ok($logger->is_warn); 156ok($logger->is_litewarn); 157ok(! $logger->is_info); 158 159 160# warn("Testing inc_level()"); 161 162#*************************** 163#increase/decrease leves 164$logger->inc_level(1); #bump up from litewarn to warn 165# warn("level is now: ", $logger->level()); 166ok($logger->is_warn); 167ok(!$logger->is_litewarn); 168ok(!$logger->is_info); 169$logger->warn("after bumping, warning message"); 170$logger->litewarn("after bumping, lite warning message, should not log"); 171open FILE, "<$LOGFILE" or die "Cannot open $LOGFILE"; 172$/ = undef; 173$data = <FILE>; 174close FILE; 175my $result5 = "WARN - after bumping, warning message\n"; 176ok($data, "$result1$result2$result3$result4$result5"); 177 178$logger->dec_level(2); #bump down from warn to litewarn to info 179 180ok($logger->is_warn); 181ok($logger->is_litewarn); 182ok($logger->is_info); 183 184ok(! $logger->is_debug) ; 185 186$logger->level($FATAL); 187 188ok($logger->is_fatal() && !($logger->is_error() || $logger->is_warn() || 189 $logger->is_info() || $logger->is_debug())); 190 191$logger->more_logging(); # should inc one level 192 193ok($logger->is_fatal() && $logger->is_error() && !( $logger->is_warn() || 194 $logger->is_info() || $logger->is_debug())); 195 196$logger->more_logging(100); # should be debug now 197 198ok($logger->is_fatal() && $logger->is_error() && $logger->is_warn() && 199 $logger->is_info() && $logger->is_debug()); 200 201$logger->less_logging(150); # should be OFF now 202 203ok(!($logger->is_fatal() || $logger->is_error() || $logger->is_warn() || 204 $logger->is_info() || $logger->is_debug())); 205 206BEGIN { plan tests => 51 }; 207 208unlink $LOGFILE; 209