#testing user-defined conversion specifiers (cspec) 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("abc.def.ghi"); $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/); BEGIN { plan tests => 15, }