###########################################
# Test Suite for Log::Log4perl::Filter
# Mike Schilli, 2003 (m@perlmeister.com)
###########################################

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

use warnings;
use strict;

use Test::More tests => 36;

use Log::Log4perl;

#############################################
# Use a pattern-matching subroutine as filter
#############################################

Log::Log4perl->init(\ <<'EOT');
  log4perl.logger.Some = INFO, A1
  log4perl.filter.MyFilter    = sub { /let this through/ }
  log4perl.appender.A1        = Log::Log4perl::Appender::TestBuffer
  log4perl.appender.A1.Filter = MyFilter
  log4perl.appender.A1.layout = Log::Log4perl::Layout::SimpleLayout
EOT

my $buffer = Log::Log4perl::Appender::TestBuffer->by_name("A1");

    # Define a logger
my $logger = Log::Log4perl->get_logger("Some.Where");

    # Let this through
$logger->info("Here's the info, let this through!");

    # Suppress this
$logger->info("Here's the info, suppress this!");

like($buffer->buffer(), qr(let this through), "pattern-match let through");
unlike($buffer->buffer(), qr(suppress), "pattern-match block");

Log::Log4perl->reset();
$buffer->reset();

#############################################
# Block in filter based on message level
#############################################
Log::Log4perl->init(\ <<'EOT');
  log4perl.logger.Some = INFO, A1
  log4perl.filter.MyFilter        = sub {    \
       my %p = @_;                           \
       ($p{log4p_level} eq "WARN") ? 1 : 0;  \
                                          }
  log4perl.appender.A1        = Log::Log4perl::Appender::TestBuffer
  log4perl.appender.A1.Filter = MyFilter
  log4perl.appender.A1.layout = Log::Log4perl::Layout::SimpleLayout
EOT

$buffer = Log::Log4perl::Appender::TestBuffer->by_name("A1");

    # Define a logger
$logger = Log::Log4perl->get_logger("Some.Where");

    # Suppress this
$logger->info("This doesn't make it");

    # Let this through
$logger->warn("This passes the hurdle");


like($buffer->buffer(), qr(passes the hurdle), "level-match let through");
unlike($buffer->buffer(), qr(make it), "level-match block");

Log::Log4perl->reset();
$buffer->reset();

#############################################
# Filter combination with Filter::Boolean
#############################################
Log::Log4perl->init(\ <<'EOT');
    log4perl.logger = INFO, A1

    log4perl.filter.Match1       = sub { /let this through/ }
    log4perl.filter.Match2       = sub { /and that, too/ }
    log4perl.filter.Match3       = Log::Log4perl::Filter::StringMatch
    log4perl.filter.Match3.StringToMatch = suppress
    log4perl.filter.Match3.AcceptOnMatch = true

    log4perl.filter.MyBoolean       = Log::Log4perl::Filter::Boolean
    log4perl.filter.MyBoolean.logic = !Match3 && (Match1 || Match2)

    log4perl.appender.A1        = Log::Log4perl::Appender::TestBuffer
    log4perl.appender.A1.Filter = MyBoolean
    log4perl.appender.A1.layout = Log::Log4perl::Layout::SimpleLayout
EOT

$buffer = Log::Log4perl::Appender::TestBuffer->by_name("A1");

    # Define a logger
$logger = Log::Log4perl->get_logger("Some.Where");

    # Let through
$logger->info("let this through");
like($buffer->buffer(), qr(let this through), "Boolean 1");
$buffer->buffer("");

    # Block
$logger->info("suppress, let this through");
is($buffer->buffer(), "", "Boolean 2");
$buffer->buffer("");

    # Let through
$logger->info("and that, too");
like($buffer->buffer(), qr(and that, too), "Boolean 3");
$buffer->buffer("");

    # Block
$logger->info("and that, too suppress");
is($buffer->buffer(), "", "Boolean 4");
$buffer->buffer("");

    # Block
$logger->info("let this through - and that, too - suppress");
is($buffer->buffer(), "", "Boolean 5");
$buffer->buffer("");

Log::Log4perl->reset();
$buffer->reset();

#############################################
# LevelMatchFilter
#############################################
Log::Log4perl->init(\ <<'EOT');
    log4perl.logger = INFO, A1
    log4perl.filter.Match1      = Log::Log4perl::Filter::LevelMatch
    log4perl.filter.Match1.LevelToMatch = INFO
    log4perl.filter.Match1.AcceptOnMatch = true
    log4perl.appender.A1        = Log::Log4perl::Appender::TestBuffer
    log4perl.appender.A1.Filter = Match1
    log4perl.appender.A1.layout = Log::Log4perl::Layout::SimpleLayout
EOT

$buffer = Log::Log4perl::Appender::TestBuffer->by_name("A1");

    # Define a logger
$logger = Log::Log4perl->get_logger("Some.Where");

    # Let through
$logger->info("let this through");
like($buffer->buffer(), qr(let this through), "Matched Level");
$buffer->buffer("");

    # Block
$logger->warn("suppress, let this through");
is($buffer->buffer(), "", "Non-Matched Level 1");
$buffer->buffer("");

    # Block
$logger->debug("and that, too");
is($buffer->buffer(), "", "Non-Matched Level 2");
$buffer->buffer("");

Log::Log4perl->reset();
$buffer->reset();

#############################################
# LevelMatchFilter - negative
#############################################
Log::Log4perl->init(\ <<'EOT');
    log4perl.logger = INFO, A1
    log4perl.filter.Match1      = Log::Log4perl::Filter::LevelMatch
    log4perl.filter.Match1.LevelToMatch = INFO
    log4perl.filter.Match1.AcceptOnMatch = false
    log4perl.appender.A1        = Log::Log4perl::Appender::TestBuffer
    log4perl.appender.A1.Filter = Match1
    log4perl.appender.A1.layout = Log::Log4perl::Layout::SimpleLayout
EOT

$buffer = Log::Log4perl::Appender::TestBuffer->by_name("A1");

    # Define a logger
$logger = Log::Log4perl->get_logger("Some.Where");

    # Block
$logger->info("let this through");
is($buffer->buffer(), "", "Non-Matched Level 1 - negative");
$buffer->buffer("");

    # Pass
$logger->warn("suppress, let this through");
like($buffer->buffer(), qr(let this through), "Matched Level - negative");
$buffer->buffer("");

    # Pass
$logger->fatal("and that, too");
like($buffer->buffer(), qr(and that, too), "Matched Level - negative");
$buffer->buffer("");

Log::Log4perl->reset();
$buffer->reset();

#############################################
# MDCFilter
#############################################
Log::Log4perl->init(\ <<'EOT');
    log4perl.logger = INFO, A1
    log4perl.filter.Match1              = Log::Log4perl::Filter::MDC
    log4perl.filter.Match1.KeyToMatch   = foo
    log4perl.filter.Match1.RegexToMatch = ^bar$
    log4perl.appender.A1        = Log::Log4perl::Appender::TestBuffer
    log4perl.appender.A1.Filter = Match1
    log4perl.appender.A1.layout = Log::Log4perl::Layout::SimpleLayout
EOT

$buffer = Log::Log4perl::Appender::TestBuffer->by_name("A1");

    # Define a logger
$logger = Log::Log4perl->get_logger("Some.Where");

    # Let through
Log::Log4perl::MDC->put(foo => 'bar');
$logger->info("let this through");
like($buffer->buffer(), qr(let this through), "MDC - passed");
$buffer->buffer("");
Log::Log4perl::MDC->remove;

    # Block
$logger->info("block this");
is($buffer->buffer(), "", "MDC - blocked");
$buffer->buffer("");

Log::Log4perl->reset();
$buffer->reset();

#############################################
# StringMatchFilter
#############################################
Log::Log4perl->init(\ <<'EOT');
    log4perl.logger = INFO, A1
    log4perl.filter.Match1      = Log::Log4perl::Filter::StringMatch
    log4perl.filter.Match1.StringToMatch = block this
    log4perl.filter.Match1.AcceptOnMatch = false
    log4perl.appender.A1        = Log::Log4perl::Appender::TestBuffer
    log4perl.appender.A1.Filter = Match1
    log4perl.appender.A1.layout = Log::Log4perl::Layout::SimpleLayout
EOT

$buffer = Log::Log4perl::Appender::TestBuffer->by_name("A1");

    # Define a logger
$logger = Log::Log4perl->get_logger("Some.Where");

    # Let through
$logger->info("let this through");
like($buffer->buffer(), qr(let this through), "StringMatch - passed");
$buffer->buffer("");

    # Block
$logger->info("block this");
is($buffer->buffer(), "", "StringMatch - blocked");
$buffer->buffer("");

Log::Log4perl->reset();
$buffer->reset();

#############################################
# StringMatchFilter - negative
#############################################
Log::Log4perl->init(\ <<'EOT');
    log4perl.logger = INFO, A1
    log4perl.filter.Match1      = Log::Log4perl::Filter::StringMatch
    log4perl.filter.Match1.StringToMatch = let this through
    log4perl.filter.Match1.AcceptOnMatch = true
    log4perl.appender.A1        = Log::Log4perl::Appender::TestBuffer
    log4perl.appender.A1.Filter = Match1
    log4perl.appender.A1.layout = Log::Log4perl::Layout::SimpleLayout
EOT

$buffer = Log::Log4perl::Appender::TestBuffer->by_name("A1");

    # Define a logger
$logger = Log::Log4perl->get_logger("Some.Where");

    # Let through
$logger->info("let this through");
like($buffer->buffer(), qr(let this through), "StringMatch - passed");
$buffer->buffer("");

    # Block
$logger->info("block this");
is($buffer->buffer(), "", "StringMatch - blocked");
$buffer->buffer("");

Log::Log4perl->reset();
$buffer->reset();

#############################################
# Non-existing filter class
#############################################
eval {
    Log::Log4perl->init(\ <<'EOT');
        log4perl.logger = INFO, A1
        log4perl.filter.Match1      = Log::Log4perl::Filter::GobbleDeGook
        log4perl.appender.A1        = Log::Log4perl::Appender::TestBuffer
        log4perl.appender.A1.Filter = Match1
        log4perl.appender.A1.layout = Log::Log4perl::Layout::SimpleLayout
EOT
};

like($@, qr/Log::Log4perl::Filter::GobbleDeGook/, "Unknown Filter");

Log::Log4perl->reset();
$buffer->reset();

#############################################
# Syntax error in subroutine
#############################################
eval {
    Log::Log4perl->init(\ <<'EOT');
        log4perl.logger = INFO, A1
        log4perl.filter.Match1      = sub { */+- };
        log4perl.appender.A1        = Log::Log4perl::Appender::TestBuffer
        log4perl.appender.A1.Filter = Match1
        log4perl.appender.A1.layout = Log::Log4perl::Layout::SimpleLayout
EOT
};

like($@, qr/Can't evaluate/, "Detect flawed filter subroutine");

Log::Log4perl->reset();
$buffer->reset();

#############################################
# LevelRangeFilter
#############################################
Log::Log4perl->init(\ <<'EOT');
    log4perl.logger = DEBUG, A1
    log4perl.filter.Range1      = Log::Log4perl::Filter::LevelRange
    log4perl.filter.Range1.LevelMin = INFO
    log4perl.filter.Range1.LevelMax = WARN
    log4perl.filter.Range1.AcceptOnMatch = true
    log4perl.appender.A1        = Log::Log4perl::Appender::TestBuffer
    log4perl.appender.A1.Filter = Range1
    log4perl.appender.A1.layout = Log::Log4perl::Layout::SimpleLayout
EOT

$buffer = Log::Log4perl::Appender::TestBuffer->by_name("A1");

    # Define a logger
$logger = Log::Log4perl->get_logger("Some.Where");

    # Block
$logger->debug("blah");
is($buffer->buffer(), "", "Outside Range");
$buffer->buffer("");

    # Let through
$logger->info("let this through");
like($buffer->buffer(), qr(let this through), "Matched Range");
$buffer->buffer("");

    # Let through
$logger->warn("let this through");
like($buffer->buffer(), qr(let this through), "Matched Range");
$buffer->buffer("");

    # Block
$logger->error("blah");
is($buffer->buffer(), "", "Outside Range");
$buffer->buffer("");

Log::Log4perl->reset();
$buffer->reset();

#############################################
# LevelRangeFilter - negative
#############################################
Log::Log4perl->init(\ <<'EOT');
    log4perl.logger = DEBUG, A1
    log4perl.filter.Range1      = Log::Log4perl::Filter::LevelRange
    log4perl.filter.Range1.LevelMin = INFO
    log4perl.filter.Range1.LevelMax = WARN
    log4perl.filter.Range1.AcceptOnMatch = false
    log4perl.appender.A1        = Log::Log4perl::Appender::TestBuffer
    log4perl.appender.A1.Filter = Range1
    log4perl.appender.A1.layout = Log::Log4perl::Layout::SimpleLayout
EOT

$buffer = Log::Log4perl::Appender::TestBuffer->by_name("A1");

    # Define a logger
$logger = Log::Log4perl->get_logger("Some.Where");

    # Let through
$logger->debug("debug msg");
like($buffer->buffer(), qr(debug msg), "Outside Range - negative");
$buffer->buffer("");

    # Block
$logger->info("block this");
is($buffer->buffer(), "", "Matched Range - negative");
$buffer->buffer("");

    # Block
$logger->warn("block this");
is($buffer->buffer(), "", "Matched Range - negative");
$buffer->buffer("");

    # Let through
$logger->error("error msg");
like($buffer->buffer(), qr(error msg), "Outside Range - negative");
$buffer->buffer("");

Log::Log4perl->reset();
$buffer->reset();

eval {
    Log::Log4perl->init(\ <<'EOT');
      log4perl.logger = INFO, A1
      log4perl.filter.Match1      = Log::Log4perl::Filter::LevelMatch
      log4perl.filter.Match1.LevelToWomper = INFO
      log4perl.appender.A1        = Log::Log4perl::Appender::TestBuffer
      log4perl.appender.A1.Filter = Match1
      log4perl.appender.A1.layout = Log::Log4perl::Layout::SimpleLayout
EOT
};

like $@, qr/Unknown parameter: LevelToWomper/, "Unknown parameter check";

#############################################
# AND-Shortcut with boolean filters
#############################################
my $counter = 0;
no warnings qw( redefine );
my $old_level_match_ok = *{ Log::Log4perl::Filter::LevelMatch::ok };
*{ Log::Log4perl::Filter::LevelMatch::ok } = sub {
    $counter++; 0 };

Log::Log4perl->init(\ <<'EOT');
log4perl.category.Some.Where = DEBUG, A1

log4perl.filter.Debug = Log::Log4perl::Filter::LevelMatch
log4perl.filter.Debug.LevelToMatch = DEBUG
log4perl.filter.Debug.AcceptOnMatch = true

log4perl.filter.Info = Log::Log4perl::Filter::LevelMatch
log4perl.filter.Info.LevelToMatch = INFO
log4perl.filter.Info.AcceptOnMatch = true

log4perl.filter.MyBoolean = Log::Log4perl::Filter::Boolean
log4perl.filter.MyBoolean.logic = Debug && Info

log4perl.appender.A1        = Log::Log4perl::Appender::TestBuffer
log4perl.appender.A1.Filter = MyBoolean
log4perl.appender.A1.layout = Log::Log4perl::Layout::SimpleLayout
EOT

$buffer = Log::Log4perl::Appender::TestBuffer->by_name("A1");

    # Define a logger
$logger = Log::Log4perl->get_logger("Some.Where");

    # Block it
$logger->debug("some message");
is($buffer->buffer(), "", "all blocked");
is( $counter, 1, "shortcut ok" );
$buffer->buffer("");

Log::Log4perl->reset();
$buffer->reset();

#############################################
# OR-Shortcut with boolean filters
#############################################
$counter = 0;
*{ Log::Log4perl::Filter::LevelMatch::ok } = sub {
    $counter++; 1 };

Log::Log4perl->init(\ <<'EOT');
log4perl.category.Some.Where = DEBUG, A1

log4perl.filter.Debug = Log::Log4perl::Filter::LevelMatch
log4perl.filter.Debug.LevelToMatch = DEBUG
log4perl.filter.Debug.AcceptOnMatch = true

log4perl.filter.Info = Log::Log4perl::Filter::LevelMatch
log4perl.filter.Info.LevelToMatch = INFO
log4perl.filter.Info.AcceptOnMatch = true

log4perl.filter.MyBoolean = Log::Log4perl::Filter::Boolean
log4perl.filter.MyBoolean.logic = Debug || Info

log4perl.appender.A1        = Log::Log4perl::Appender::TestBuffer
log4perl.appender.A1.Filter = MyBoolean
log4perl.appender.A1.layout = Log::Log4perl::Layout::SimpleLayout
EOT

$buffer = Log::Log4perl::Appender::TestBuffer->by_name("A1");

    # Define a logger
$logger = Log::Log4perl->get_logger("Some.Where");

    # Block it
$logger->debug("some message");
like($buffer->buffer(), qr/some message/, "all blocked");
is( $counter, 1, "shortcut ok" );
$buffer->buffer("");

Log::Log4perl->reset();
$buffer->reset();

*{ Log::Log4perl::Filter::LevelMatch::ok } = $old_level_match_ok;