########################################### # Test Suite for Log::Log4perl::Config # Erik Selberg, (c) 2002 erik@selberg.com # clone of 025CustLevels.t but uses nicer method (?) we hope ########################################### ######################### # change 'tests => 1' to 'tests => last_test_to_print'; ######################### use Test; #create a custom level "LITEWARN" use Log::Log4perl; use Log::Log4perl::Level; use Log::Log4perl::Appender::TestBuffer; # use strict; ok(1); # If we made it this far, we're ok. Log::Log4perl::Logger::create_custom_level("LITEWARN", "WARN"); #testing for bugfix of 9/19/03 before which custom levels beneath DEBUG didn't work Log::Log4perl::Logger::create_custom_level("DEBUG2", "DEBUG"); # test insane creation of levels foreach (1 .. 14) { ok(Log::Log4perl::Logger::create_custom_level("TEST$_", "INFO"), 0); } # 15th should fail.. this assumes that each level is 10000 apart from # the other. ok(!defined eval { Log::Log4perl::Logger::create_custom_level("TEST15", "INFO") }); # now, by re-arranging (as we whine about in create_custom_levels), we # should be able to get 15. my %btree = ( 8 => "DEBUG", 4 => 8, 2 => 4, 1 => 2, 3 => 4, 6 => 8, 5 => 6, 7 => 8, 12 => "DEBUG", 10 => 12, 9 => 10, 11 => 12, 14 => "DEBUG", 13 => 14, 15 => "DEBUG", ); foreach (8, 4, 2, 1, 3, 6, 5, 7, 12, 10, 9, 11, 14, 13, 15) { my $level = $btree{$_} eq "DEBUG" ? "DEBUG" : "BTREE$btree{$_}"; # warn("Creating BTREE$_ after $level"); ok(Log::Log4perl::Logger::create_custom_level("BTREE$_", $level), 0); # warn("BTREE$_ is ", ${Log::Log4perl::Level::PRIORITY{"BTREE$_"}}); } # foreach (1 .. 15) { # warn("BTREE$_ is: ", ${Log::Log4perl::Level::PRIORITY{"BTREE$_"}}); # } my $LOGFILE = "example.log"; unlink $LOGFILE; my $config = <get_logger("groceries.beer"); $logger->warn("this is a warning message"); $logger->litewarn("this is a LITE warning message (2/3 the calories)"); $logger->info("this info message should not log"); open FILE, "<$LOGFILE" or die "Cannot open $LOGFILE"; $/ = undef; my $data = ; close FILE; my $result1 = "WARN - this is a warning message\nLITEWARN - this is a LITE warning message (2/3 the calories)\n"; ok($data, $result1); # ********************* # check the root logger my $rootlogger = Log::Log4perl->get_logger(""); $logger->warn("this is a rootlevel warning message"); $logger->litewarn("this is a rootlevel LITE warning message (2/3 the calories)"); $logger->info("this rootlevel info message should not log"); open FILE, "<$LOGFILE" or die "Cannot open $LOGFILE"; $/ = undef; $data = ; close FILE; my $result2 = "WARN - this is a rootlevel warning message\nLITEWARN - this is a rootlevel LITE warning message (2/3 the calories)\n"; ok($data, "$result1$result2"); $logger->log($WARN, "a warning message"); $logger->log($LITEWARN, "a LITE warning message"); die("lame hack to suppress warning") if ($LITEWARN != $LITEWARN); $logger->log($DEBUG, "an info message, should not log"); open FILE, "<$LOGFILE" or die "Cannot open $LOGFILE"; $/ = undef; $data = ; close FILE; my $result3 = "WARN - a warning message\nLITEWARN - a LITE warning message\n"; ok($data, "$result1$result2$result3"); # ********************* # check debug2 level my $debug2 = Log::Log4perl->get_logger("debug2test"); $debug2->debug2("this is a debug2 message"); open FILE, "<$LOGFILE" or die "Cannot open $LOGFILE"; $/ = undef; $data = ; close FILE; my $result4 = "DEBUG2 - this is a debug2 message\n"; ok($data, "$result1$result2$result3$result4"); #********************* #check the is_* methods ok($logger->is_warn); ok($logger->is_litewarn); ok(! $logger->is_info); # warn("Testing inc_level()"); #*************************** #increase/decrease leves $logger->inc_level(1); #bump up from litewarn to warn # warn("level is now: ", $logger->level()); ok($logger->is_warn); ok(!$logger->is_litewarn); ok(!$logger->is_info); $logger->warn("after bumping, warning message"); $logger->litewarn("after bumping, lite warning message, should not log"); open FILE, "<$LOGFILE" or die "Cannot open $LOGFILE"; $/ = undef; $data = ; close FILE; my $result5 = "WARN - after bumping, warning message\n"; ok($data, "$result1$result2$result3$result4$result5"); $logger->dec_level(2); #bump down from warn to litewarn to info ok($logger->is_warn); ok($logger->is_litewarn); ok($logger->is_info); ok(! $logger->is_debug) ; $logger->level($FATAL); ok($logger->is_fatal() && !($logger->is_error() || $logger->is_warn() || $logger->is_info() || $logger->is_debug())); $logger->more_logging(); # should inc one level ok($logger->is_fatal() && $logger->is_error() && !( $logger->is_warn() || $logger->is_info() || $logger->is_debug())); $logger->more_logging(100); # should be debug now ok($logger->is_fatal() && $logger->is_error() && $logger->is_warn() && $logger->is_info() && $logger->is_debug()); $logger->less_logging(150); # should be OFF now ok(!($logger->is_fatal() || $logger->is_error() || $logger->is_warn() || $logger->is_info() || $logger->is_debug())); BEGIN { plan tests => 51 }; unlink $LOGFILE;