1 files changed, 516 insertions, 0 deletions
diff --git a/t/040Filter.t b/t/040Filter.t
new file mode 100644
index 0000000..a4a0cb8
--- /dev/null
+++ b/t/040Filter.t
@@ -0,0 +1,516 @@
+###########################################
+# 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;