The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
###########################################
# Test Suite for Log::Log4perl::Config
# Erik Selberg, (c) 2002 erik@selberg.com
# clone of 025CustLevels.t but uses nicer method (?) we hope
###########################################

BEGIN { 
    if($ENV{INTERNAL_DEBUG}) {
        require Log::Log4perl::InternalDebug;
        Log::Log4perl::InternalDebug->enable();
    }
}

#########################
# 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 = <<EOT;
log4j.category = LITEWARN, FileAppndr
log4j.appender.FileAppndr          = Log::Log4perl::Appender::File
log4j.appender.FileAppndr.filename = $LOGFILE
log4j.appender.FileAppndr.layout   = Log::Log4perl::Layout::SimpleLayout

log4j.category.debug2test = DEBUG2, FileAppndr
log4j.additivity.debug2test= 0
EOT


Log::Log4perl::init(\$config);


# can't create a custom level after init... let's test that. Just look
# for an undef (i.e. failure) from the eval

ok(!defined eval { Log::Log4perl::Logger::create_custom_level("NOTIFY", "WARN"); });


# *********************
# check a category logger

my $logger = Log::Log4perl->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 = <FILE>;
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 = <FILE>;
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 = <FILE>;
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 = <FILE>;
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 = <FILE>;
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;