1 files changed, 314 insertions, 0 deletions
diff --git a/t/033UsrCspec.t b/t/033UsrCspec.t
new file mode 100644
index 0000000..36651be
--- /dev/null
+++ b/t/033UsrCspec.t
@@ -0,0 +1,314 @@
+#testing user-defined conversion specifiers (cspec)
+
+BEGIN { 
+    if($ENV{INTERNAL_DEBUG}) {
+        require Log::Log4perl::InternalDebug;
+        Log::Log4perl::InternalDebug->enable();
+    }
+}
+
+use Test::More;
+use Log::Log4perl;
+use Log::Log4perl::Appender::TestBuffer;
+use File::Spec;
+
+Log::Log4perl::Appender::TestBuffer->reset();
+
+
+my $config = <<'EOL';
+log4j.category.plant    = DEBUG, appndr1
+log4j.category.animal   = DEBUG, appndr2
+
+#'U' a global user-defined cspec
+log4j.PatternLayout.cspec.U =       \
+        sub {                       \
+            return "UID $< GID $("; \
+        }                           \
+    
+  
+# ********************
+# first appender
+log4j.appender.appndr1        = Log::Log4perl::Appender::TestBuffer
+#log4j.appender.appndr1        = Log::Log4perl::Appender::Screen
+log4j.appender.appndr1.layout = org.apache.log4j.PatternLayout
+log4j.appender.appndr1.layout.ConversionPattern = %K xx %G %U
+
+#'K' cspec local to appndr1                 (pid in hex)
+log4j.appender.appndr1.layout.cspec.K = sub { return sprintf "%1x", $$}
+
+#'G' cspec unique to appdnr1
+log4j.appender.appndr1.layout.cspec.G = sub {return 'thisistheGcspec'}
+
+    
+
+# ********************
+# second appender
+log4j.appender.appndr2        = Log::Log4perl::Appender::TestBuffer
+#log4j.appender.appndr2        = Log::Log4perl::Appender::Screen
+log4j.appender.appndr2.layout = org.apache.log4j.PatternLayout
+log4j.appender.appndr2.layout.ConversionPattern = %K %U
+
+#'K' cspec local to appndr2
+log4j.appender.appndr2.layout.cspec.K =                              \
+    sub {                                                            \
+        my ($self, $message, $category, $priority, $caller_level) = @_; \
+        $message =~ /--- (.+) ---/;                                  \
+        my $snippet = $1;                                            \
+        return ucfirst(lc($priority)).'-'.$snippet.'-'.ucfirst(lc($priority));                 \
+      }
+      
+#override global 'U' cspec
+log4j.appender.appndr2.layout.cspec.U = sub {return 'foobar'}
+      
+EOL
+
+
+Log::Log4perl::init(\$config);
+
+my $plant = Log::Log4perl::get_logger('plant');
+my $animal = Log::Log4perl::get_logger('animal');
+
+
+my $hexpid = sprintf "%1x", $$;
+my $uid = $<;
+my $gid = $(;
+
+
+my $plantbuffer = Log::Log4perl::Appender::TestBuffer->by_name("appndr1");
+my $animalbuffer = Log::Log4perl::Appender::TestBuffer->by_name("appndr2");
+
+$plant->fatal('blah blah blah --- plant --- yadda yadda');
+is($plantbuffer->buffer(), "$hexpid xx thisistheGcspec UID $uid GID $gid");
+$plantbuffer->reset;
+
+$animal->fatal('blah blah blah --- animal --- yadda yadda');
+is($animalbuffer->buffer(), "Fatal-animal-Fatal foobar");
+$animalbuffer->reset;
+
+$plant->error('blah blah blah --- plant --- yadda yadda');
+is($plantbuffer->buffer(), "$hexpid xx thisistheGcspec UID $uid GID $gid");
+$plantbuffer->reset;
+
+$animal->error('blah blah blah --- animal --- yadda yadda');
+is($animalbuffer->buffer(), "Error-animal-Error foobar");
+$animalbuffer->reset;
+
+$plant->warn('blah blah blah --- plant --- yadda yadda');
+is($plantbuffer->buffer(), "$hexpid xx thisistheGcspec UID $uid GID $gid");
+$plantbuffer->reset;
+
+$animal->warn('blah blah blah --- animal --- yadda yadda');
+is($animalbuffer->buffer(), "Warn-animal-Warn foobar");
+$animalbuffer->reset;
+
+$plant->info('blah blah blah --- plant --- yadda yadda');
+is($plantbuffer->buffer(), "$hexpid xx thisistheGcspec UID $uid GID $gid");
+$plantbuffer->reset;
+
+$animal->info('blah blah blah --- animal --- yadda yadda');
+is($animalbuffer->buffer(), "Info-animal-Info foobar");
+$animalbuffer->reset;
+
+$plant->debug('blah blah blah --- plant --- yadda yadda'); 
+is($plantbuffer->buffer(), "$hexpid xx thisistheGcspec UID $uid GID $gid");
+$plantbuffer->reset;
+
+$animal->debug('blah blah blah --- animal --- yadda yadda'); 
+is($animalbuffer->buffer(), "Debug-animal-Debug foobar");
+$animalbuffer->reset;
+
+
+#now test the api call we're adding
+
+Log::Log4perl::Layout::PatternLayout::add_global_cspec('Z', sub {'zzzzzzzz'}); #snooze?
+
+
+my $app = Log::Log4perl::Appender->new(
+    "Log::Log4perl::Appender::TestBuffer");
+
+my $logger = Log::Log4perl->get_logger("plant");
+$logger->add_appender($app);
+my $layout = Log::Log4perl::Layout::PatternLayout->new(
+    "%m %Z");
+$app->layout($layout);
+$logger->debug("That's the message");
+
+is($app->buffer(), "That's the message zzzzzzzz");
+
+###########################################################
+#testing perl code snippets in Log4perl configuration files
+###########################################################
+
+Log::Log4perl::Appender::TestBuffer->reset();
+
+$config = <<'EOL';
+log4perl.category.some = DEBUG, appndr
+
+    # This should be evaluated at config parse time
+log4perl.appender.appndr = sub { \
+    return "Log::Log4perl::Appender::TestBuffer" }
+log4perl.appender.appndr.layout = Log::Log4perl::Layout::PatternLayout
+    # This should be evaluated at config parse time ("%m %K%n")
+log4perl.appender.appndr.layout.ConversionPattern = sub{ "%" . \
+    chr(109) . " %K%n"; }
+
+    # This should be evaluated at run time ('K' cspec)
+log4perl.appender.appndr.layout.cspec.K = sub { $ENV{TEST_VALUE} }
+EOL
+
+Log::Log4perl::init(\$config);
+
+$ENV{TEST_VALUE} = "env_value";
+
+$logger = Log::Log4perl::get_logger('some');
+$logger->debug("log_message");
+
+$ENV{TEST_VALUE} = "env_value2";
+$logger->info("log_message2");
+
+my $buffer = Log::Log4perl::Appender::TestBuffer->by_name("appndr");
+
+#print "Testbuffer: ", $buffer->buffer(), "\n";
+
+is($buffer->buffer(), "log_message env_value\nlog_message2 env_value2\n");
+
+###########################################################
+#testing perl code snippets with ALLOW_CODE_IN_CONFIG_FILE 
+#disabled
+###########################################################
+
+Log::Log4perl::Appender::TestBuffer->reset();
+
+$config = <<'EOL';
+log4perl.category.some = DEBUG, appndr
+
+    # This should be evaluated at config parse time
+log4perl.appender.appndr = Log::Log4perl::Appender::TestBuffer
+log4perl.appender.appndr.layout = Log::Log4perl::Layout::PatternLayout
+    # This should be evaluated at config parse time ("%m %K%n")
+log4perl.appender.appndr.layout.ConversionPattern = sub{ "%m" . \
+    chr(109) . " %n"; }
+EOL
+
+Log::Log4perl::Config::allow_code(0);
+
+eval {
+    Log::Log4perl::init(\$config);
+};
+
+print "ERR is $@\n";
+
+if($@ and $@ =~ /prohibits/) {
+    ok(1);
+} else {
+    ok(0);
+}
+
+# Test if cspecs are denied
+Log::Log4perl::Appender::TestBuffer->reset();
+
+$config = <<'EOL';
+log4perl.category.some = DEBUG, appndr
+
+    # This should be evaluated at config parse time
+log4perl.appender.appndr = Log::Log4perl::Appender::TestBuffer
+log4perl.appender.appndr.layout = Log::Log4perl::Layout::PatternLayout
+log4perl.appender.appndr.layout.ConversionPattern = %m %n
+log4perl.appender.appndr.layout.cspec.K = sub { $ENV{TEST_VALUE} }
+EOL
+
+Log::Log4perl::Config->allow_code(0);
+
+eval {
+    Log::Log4perl::init(\$config);
+};
+
+print "ERR is $@\n";
+
+if($@ and $@ =~ /prohibits/) {
+    ok(1);
+} else {
+    ok(0);
+}
+
+################################################################
+# Test if cspecs are passing the correct caller level
+################################################################
+Log::Log4perl::Config::allow_code(1);
+Log::Log4perl::Appender::TestBuffer->reset();
+
+$config = <<'EOL';
+log4perl.category.some = DEBUG, appndr
+
+    # This should be evaluated at config parse time
+log4perl.appender.appndr = Log::Log4perl::Appender::TestBuffer
+log4perl.appender.appndr.layout = Log::Log4perl::Layout::PatternLayout
+log4perl.appender.appndr.layout.ConversionPattern = %K %m %n
+log4perl.appender.appndr.layout.cspec.K = sub { return (caller($_[4]))[1] }
+EOL
+
+Log::Log4perl::init(\$config);
+
+my $some = Log::Log4perl::get_logger('some');
+$some->debug("blah");
+
+my $somebuffer = Log::Log4perl::Appender::TestBuffer->by_name("appndr");
+
+like($somebuffer->buffer(), qr/033UsrCspec.t blah/);
+
+################################################################
+# cspecs with parameters in curlies
+################################################################
+Log::Log4perl::Config::allow_code(1);
+Log::Log4perl::Appender::TestBuffer->reset();
+
+our %hash = (foo => "bar", quack => "schmack");
+$hash{hollerin} = "hootin"; # shut up perl warnings
+
+use Data::Dumper;
+$config = <<'EOL';
+log4perl.category.some = DEBUG, appndr
+
+    # This should be evaluated at config parse time
+log4perl.appender.appndr = Log::Log4perl::Appender::TestBuffer
+log4perl.appender.appndr.layout = Log::Log4perl::Layout::PatternLayout
+log4perl.appender.appndr.layout.ConversionPattern = %K{foo} %m %K{quack}%n
+log4perl.appender.appndr.layout.cspec.K = sub { $main::hash{$_[0]->{curlies} } }
+EOL
+
+Log::Log4perl::init(\$config);
+
+$some = Log::Log4perl::get_logger('some');
+$some->debug("blah");
+
+$somebuffer = Log::Log4perl::Appender::TestBuffer->by_name("appndr");
+
+is($somebuffer->buffer(), "bar blah schmack\n");
+
+################################################################
+# Get the calling package from a cspec
+################################################################
+Log::Log4perl::Config::allow_code(1);
+Log::Log4perl::Appender::TestBuffer->reset();
+
+$config = <<'EOL';
+log4perl.category.some = DEBUG, appndr
+
+    # This should be evaluated at config parse time
+log4perl.appender.appndr = Log::Log4perl::Appender::TestBuffer
+log4perl.appender.appndr.layout = Log::Log4perl::Layout::PatternLayout
+log4perl.appender.appndr.layout.ConversionPattern = %K %m%n
+log4perl.appender.appndr.layout.cspec.K = \
+    sub { scalar caller( $_[4] )}
+EOL
+
+Log::Log4perl::init(\$config);
+
+$some = Log::Log4perl::get_logger('some');
+$some->debug("blah");
+
+$somebuffer = Log::Log4perl::Appender::TestBuffer->by_name("appndr");
+
+is($somebuffer->buffer(), "main blah\n");
+
+BEGIN { plan tests => 17, }