The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
###########################################
# Test Suite for Log::Log4perl
# Mike Schilli, 2002 (m@perlmeister.com)
###########################################

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

#########################
# change 'tests => 1' to 'tests => last_test_to_print';
#########################
use Test::More;
BEGIN { plan tests => 28 };

use Log::Log4perl;
use Log::Log4perl::Appender::TestBuffer;
use File::Spec;

my $EG_DIR = "eg";
$EG_DIR = "../eg" unless -d $EG_DIR;

my $TMP_FILE = File::Spec->catfile($EG_DIR, "warnings");

ok(1, "Startup"); # If we made it this far, we are ok.

######################################################################
# Test the root logger on a configuration file defining a file appender
######################################################################
Log::Log4perl->init("$EG_DIR/log4j-manual-1.conf");

my $logger = Log::Log4perl->get_logger("");
$logger->debug("Gurgel");


like(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(), 
   qr#^\d+\s+\[N/A\] DEBUG  N/A - Gurgel$#, "Root logger"); 

######################################################################
# Test the root logger via inheritance (discovered by Kevin Goess)
######################################################################
Log::Log4perl::Appender::TestBuffer->reset();

Log::Log4perl->init("$EG_DIR/log4j-manual-1.conf");

$logger = Log::Log4perl->get_logger("foo");
$logger->debug("Gurgel");

like(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(),
    qr#^\d+\s+\[N/A\] DEBUG foo N/A - Gurgel$#, "Root logger inherited"); 

######################################################################
# Test init with a string
######################################################################
Log::Log4perl::Appender::TestBuffer->reset();

Log::Log4perl->init(\ <<EOT);
log4j.rootLogger=DEBUG, A1
log4j.appender.A1=Log::Log4perl::Appender::TestBuffer
log4j.appender.A1.layout=org.apache.log4j.PatternLayout
log4j.appender.A1.layout.ConversionPattern=%-4r [%t] %-5p %c - %m%n
EOT

$logger = Log::Log4perl->get_logger("foo");
$logger->debug("Gurgel");

like(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(),
    qr#^\d+\s+\[N/A\] DEBUG foo - Gurgel$#, "Init via string"); 

######################################################################
# Test init with a hashref
######################################################################
Log::Log4perl::Appender::TestBuffer->reset();

my %hash = (
    "log4j.rootLogger"         => "DEBUG, A1",
    "log4j.appender.A1"        => "Log::Log4perl::Appender::TestBuffer",
    "log4j.appender.A1.layout" => "org.apache.log4j.PatternLayout",
    "log4j.appender.A1.layout.ConversionPattern" => 
                                  "%-4r [%t] %-5p %c - %m%n"
    );

Log::Log4perl->init(\%hash);

$logger = Log::Log4perl->get_logger("foo");
$logger->debug("Gurgel");

like(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(),
    qr#^\d+\s+\[N/A\] DEBUG foo - Gurgel$#, "Init via hashref"); 


############################################################
# testing multiple parameters, nested hashes
############################################################

our $stub_hook;

# -----------------------------------
# here is a stub
package Log::Log4perl::AppenderTester;
sub new {
    my($class, %params) = @_;
    my $self = {};
    bless $self, $class;

    $self->{P} = \%params;

    $main::stub_hook = $self;
    
    return $self;
}
package main;
# -----------------------------------

Log::Log4perl->init(\ <<'EOT');
#here is an example of using Log::Dispatch::Jabber

log4j.category.animal.dog   = INFO, jabbender

log4j.appender.jabbender          = Log::Log4perl::AppenderTester
log4j.appender.jabbender.layout   = Log::Log4perl::Layout::SimpleLayout
log4j.appender.jabbender.login.hostname = a.jabber.server
log4j.appender.jabbender.login.port = 5222
log4j.appender.jabbender.login.username =  bugs
log4j.appender.jabbender.login.password = bunny
log4j.appender.jabbender.login.resource = logger
log4j.appender.jabbender.to = elmer@a.jabber.server
log4j.appender.jabbender.to = sam@another.jabber.server

EOT

#should produce this:
#{
#    login => {
#          hostname => "a.jabber.server",
#          password => "bunny",
#          port     => 5222,
#          resource => "logger",
#          username => "bugs",
#        },
#    to => ["elmer\@a.jabber.server", "sam\@another.jabber.server"],
#  },


is($stub_hook->{P}{login}{hostname}, 'a.jabber.server', "Config and Jabber");
is($stub_hook->{P}{login}{password}, 'bunny', "Config and Jabber");
is($stub_hook->{P}{to}[0], 'elmer@a.jabber.server', "Config and Jabber");
is($stub_hook->{P}{to}[1], 'sam@another.jabber.server', "Config and Jabber");

##########################################################################
# Test what happens if we define a PatternLayout without ConversionPattern
##########################################################################
Log::Log4perl::Appender::TestBuffer->reset();

$conf = <<EOT;
    log4perl.logger.Twix.Bar = DEBUG, A1
    log4perl.appender.A1=Log::Log4perl::Appender::TestBuffer
    log4perl.appender.A1.layout=PatternLayout
    #log4perl.appender.A1.layout.ConversionPattern=%d-%c %m%n
EOT

eval { Log::Log4perl->init(\$conf); };


#actually, it turns out that log4j handles this, if no ConversionPattern
#specified is uses DEFAULT_LAYOUT_PATTERN, %m%n
#ok($@, '/No ConversionPattern given for PatternLayout/'); 
is($@, '', 'PatternLayout without ConversionPattern'); 

######################################################################
# Test with $/ set to undef
######################################################################
$/ = undef;
Log::Log4perl->init("$EG_DIR/log4j-manual-1.conf");

$logger = Log::Log4perl->get_logger("");
$logger->debug("Gurgel");

like(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(), 
     qr#^\d+\s+\[N/A\] DEBUG  N/A - Gurgel$#, "Config in slurp mode"); 

######################################################################
# Test init with a config parser object
######################################################################
Log::Log4perl::Appender::TestBuffer->reset();

my $parser = Log::Log4perl::Config::PropertyConfigurator->new();
my @lines = split "\n", <<EOT;
log4j.rootLogger         = DEBUG, A1
log4j.appender.A1        = Log::Log4perl::Appender::TestBuffer
log4j.appender.A1.layout = org.apache.log4j.PatternLayout
log4j.appender.A1.layout.ConversionPattern = object%m%n
EOT
$parser->text(\@lines);

Log::Log4perl->init($parser);

$logger = Log::Log4perl->get_logger("foo");
$logger->debug("Gurgel");

is(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(), 
   "objectGurgel\n", "Init with parser object"); 

######################################################################
# Test integrity check
######################################################################
open STDERR, ">$TMP_FILE";
open IN, "<$TMP_FILE" or die "Cannot open $TMP_FILE";
sub readwarn { return (scalar <IN>) || ''; }
END { close IN }

Log::Log4perl->init(\ <<EOT);
    # Just an empty configuration
EOT

like(readwarn(), qr/looks suspicious: No loggers/, 
     "Test integrity check on empty conf file");

close STDERR;
close IN;
unlink $TMP_FILE;

######################################################################
# Misspelled 'rootlogger' (needs to be rootLogger)
######################################################################
open STDERR, ">$TMP_FILE";
open IN, "<$TMP_FILE" or die "Cannot open $TMP_FILE";

Log::Log4perl->reset();
$Log::Log4perl::Logger::LOGGERS_BY_NAME = {};

Log::Log4perl->init(\ <<EOT);
  log4perl.rootlogger=ERROR, LOGFILE

  log4perl.appender.LOGFILE=Log::Log4perl::Appender::Screen
  log4perl.appender.LOGFILE.layout=PatternLayout
  log4perl.appender.LOGFILE.layout.ConversionPattern=[%r] %F %L %c - %m %n
EOT

is(readwarn(), "", "Autocorrecting rootLogger/rootlogger typo");

close STDERR;
close IN;
unlink $TMP_FILE;

######################################################################
# Totally misspelled rootLogger
######################################################################
open STDERR, ">$TMP_FILE";
open IN, "<$TMP_FILE" or die "Cannot open $TMP_FILE";

Log::Log4perl->reset();
$Log::Log4perl::Logger::LOGGERS_BY_NAME = {};

Log::Log4perl->init(\ <<EOT);
  log4perl.schtonk=ERROR, LOGFILE

  log4perl.appender.LOGFILE=Log::Log4perl::Appender::Screen
  log4perl.appender.LOGFILE.layout=PatternLayout
  log4perl.appender.LOGFILE.layout.ConversionPattern=[%r] %F %L %c - %m %n
EOT

like(readwarn(), qr/looks suspicious: No loggers/, 
     "Test integrity check on totally misspelled rootLogger typo");

close STDERR;
close IN;
unlink $TMP_FILE;

######################################################################
# PatternLayout %m{}
######################################################################
Log::Log4perl::Appender::TestBuffer->reset();

Log::Log4perl->init(\ <<EOT);
log4j.logger.foo=DEBUG, A1
log4j.appender.A1=Log::Log4perl::Appender::TestBuffer
log4j.appender.A1.layout=org.apache.log4j.PatternLayout
log4j.appender.A1.layout.ConversionPattern=%M%m
EOT

###########################################
sub somefunc {
###########################################
    $logger = Log::Log4perl->get_logger("foo");
    $logger->debug("Gurgel");
}

package SomePackage;
###########################################
sub somepackagefunc {
###########################################
    $logger = Log::Log4perl->get_logger("foo");
    $logger->debug("Gurgel");
}
package main;

somefunc();
is(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(),
        "main::somefuncGurgel", "%M main");

Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer("");
SomePackage::somepackagefunc();
is(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(), 
        "SomePackage::somepackagefuncGurgel", "%M in package");

######################################################################
# PatternLayout %m{1}
######################################################################
Log::Log4perl::Appender::TestBuffer->reset();

Log::Log4perl->init(\ <<EOT);
log4j.logger.foo=DEBUG, A1
log4j.appender.A1=Log::Log4perl::Appender::TestBuffer
log4j.appender.A1.layout=org.apache.log4j.PatternLayout
log4j.appender.A1.layout.ConversionPattern=%M{1}%m
EOT

somefunc();
is(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(),
        "somefuncGurgel", "%M{1} main");

Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer("");
SomePackage::somepackagefunc();
is(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(), 
        "somepackagefuncGurgel", "%M{1} package");

######################################################################
# PatternLayout %p{1}
######################################################################
Log::Log4perl::Appender::TestBuffer->reset();

Log::Log4perl->init(\ <<EOT);
log4j.logger.foo=DEBUG, A1
log4j.appender.A1=Log::Log4perl::Appender::TestBuffer
log4j.appender.A1.layout=org.apache.log4j.PatternLayout
log4j.appender.A1.layout.ConversionPattern=-%p{1}- %m
EOT

somefunc();
is(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(),
        "-D- Gurgel", "%p{1} main");

Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer("");
SomePackage::somepackagefunc();
is(Log::Log4perl::Appender::TestBuffer->by_name("A1")->buffer(), 
        "-D- Gurgel", "%p{1} package");

######################################################################
# Test accessors
######################################################################
$parser = Log::Log4perl::Config::PropertyConfigurator->new();
@lines = split "\n", <<EOT;
log4j.rootLogger         = DEBUG, A1
log4j.appender.A1        = Log::Log4perl::Appender::TestBuffer
log4j.appender.A1.layout = org.apache.log4j.PatternLayout
log4j.appender.A1.layout.ConversionPattern = object%m%n
EOT
$parser->text(\@lines);
$parser->parse();
is($parser->value("log4j.rootLogger"), "DEBUG, A1", "value() accessor");
is($parser->value("log4j.foobar"), undef, "value() accessor undef");

is($parser->value("log4j.appender.A1"), 
   "Log::Log4perl::Appender::TestBuffer", "value() accessor");

is($parser->value("log4perl.appender.A1.layout.ConversionPattern"), 
   "object%m%n", "value() accessor log4perl");

######################################################################
# Test accessors
######################################################################
my $conf = q{
log4perl.category.pf.trigger = DEBUG
log4j.appender.A1        = Log::Log4perl::Appender::TestBuffer
log4j.appender.A1.layout = org.apache.log4j.PatternLayout
log4j.appender.A1.layout.ConversionPattern = object%m%n
};

eval { Log::Log4perl->init( \$conf ); };

is $@, "", "'trigger' category [rt.cpan.org #50495]";

######################################################################
# Test alternate comment syntax
######################################################################

$conf = <<'END_CONF';
log4perl.MyParam = MyVal
; log4perl.MyParam = AnotherVal
END_CONF

eval { Log::Log4perl->init( \$conf ); };
is $@, "", "support semi-colon comment character [github.com #24]";

$conf = <<'END_CONF';
log4perl.MyParam = MyVal
! log4perl.MyParam = AnotherVal
END_CONF

eval { Log::Log4perl->init( \$conf ); };
is $@, "", "support exclamation comment character [github.com #24]";