diff --git a/Changes b/Changes index 2d539dcc..782dac6b 100644 --- a/Changes +++ b/Changes @@ -11,6 +11,8 @@ https://github.com/mschilli/log4perl/issues/7), so I put on my hazmat suit and cleaned it up. Now perl's garbage collector takes care of disposing of logger and appender carcasses. + * (ms) Added Log::Log4perl->remove_logger($logger) to remove a logger + from the system. 1.32 (2011/02/26) * (ms) Fixed %T caller_depth with wrapper_register(), reported diff --git a/lib/Log/Log4perl.pm b/lib/Log/Log4perl.pm index 9b1f9ddd..9a51aac6 100644 --- a/lib/Log/Log4perl.pm +++ b/lib/Log/Log4perl.pm @@ -559,6 +559,34 @@ sub easy_closure_global_cleanup { } } +########################################### +sub easy_closure_logger_remove { +########################################### + my($class, $logger) = @_; + + PKG: for my $caller_pkg ( keys %$EASY_CLOSURES ) { + for my $entry ( keys %{ $EASY_CLOSURES->{ $caller_pkg } } ) { + if( $logger == $EASY_CLOSURES->{ $caller_pkg }->{ $entry } ) { + easy_closure_category_cleanup( $caller_pkg ); + next PKG; + } + } + } +} + +################################################## +sub remove_logger { +################################################## + my ($class, $logger) = @_; + + # Any stealth logger convenience function still using it will + # now become a no-op. + Log::Log4perl->easy_closure_logger_remove( $logger ); + + # Remove the logger from the system + delete $Log::Log4perl::Logger::LOGGERS_BY_NAME->{ $logger->{category} }; +} + 1; __END__ @@ -2483,6 +2511,12 @@ you need to call Ceradicate_appender($appender_name)> which will first remove the appender from every logger in the system and then will delete all references Log4perl holds to it. +To remove a logger from the system, use +Cremove_logger($logger)>. After the remaining +reference C<$logger> goes away, the logger will self-destruct. If the +logger in question is a stealth logger, all of its convenience shortcuts +(DEBUG, INFO, etc) will turn into no-ops. + =head1 How about Log::Dispatch::Config? Tatsuhiko Miyagawa's C is a very clever diff --git a/lib/Log/Log4perl/Logger.pm b/lib/Log/Log4perl/Logger.pm index fd6b52ba..3b03680b 100644 --- a/lib/Log/Log4perl/Logger.pm +++ b/lib/Log/Log4perl/Logger.pm @@ -79,8 +79,8 @@ sub cleanup { ################################################## sub DESTROY { ################################################## - CORE::warn - "Destroying logger $_[0]" if $Log::Log4perl::CHATTY_DESTROY_METHODS; + CORE::warn "Destroying logger $_[0] ($_[0]->{category})" + if $Log::Log4perl::CHATTY_DESTROY_METHODS; } ################################################## @@ -1074,8 +1074,6 @@ sub dec_level { $self->set_output_methods; } -################################################## - 1; __END__ diff --git a/t/063LoggerRemove.t b/t/063LoggerRemove.t new file mode 100755 index 00000000..508f08a4 --- /dev/null +++ b/t/063LoggerRemove.t @@ -0,0 +1,56 @@ +# http://stackoverflow.com/questions/5914088 and +# https://github.com/mschilli/log4perl/issues/7 + +use strict; +use Test::More; +use Log::Log4perl::Appender::TestBuffer; + +plan tests => 6; + +use Log::Log4perl qw(get_logger :easy); + +# $Log::Log4perl::CHATTY_DESTROY_METHODS = 1; + +my $conf = q( +log4perl.category.main = WARN, LogBuffer +log4perl.category.Bar.Twix = WARN, LogBuffer +log4perl.appender.LogBuffer = Log::Log4perl::Appender::TestBuffer +log4perl.appender.LogBuffer.layout = \ +Log::Log4perl::Layout::PatternLayout +log4perl.appender.LogBuffer.layout.ConversionPattern = %d %F{1} %L> %m %n +); + +Log::Log4perl::init(\$conf); + +my $buffer = Log::Log4perl::Appender::TestBuffer->by_name("LogBuffer"); + +my $logger = get_logger("Bar::Twix"); + +ok(exists $Log::Log4perl::Logger::LOGGERS_BY_NAME->{"Bar.Twix"}, + "logger exists"); + +Log::Log4perl->remove_logger( $logger ); +undef $logger; + +ok(!exists $Log::Log4perl::Logger::LOGGERS_BY_NAME->{"Bar.Twix"}, + "logger gone"); + +# now remove a stealth logger +$logger = get_logger("main"); + +ok(exists $Log::Log4perl::Logger::LOGGERS_BY_NAME->{"main"}, + "logger exists"); + +WARN "before"; + +Log::Log4perl->remove_logger( $logger ); +undef $logger; + +ok(!exists $Log::Log4perl::Logger::LOGGERS_BY_NAME->{"main"}, + "logger gone"); + + # this should be a no-op now. +WARN "after"; + +like($buffer->buffer, qr/before/, "log message before logger removal present"); +unlike($buffer->buffer, qr/after/, "log message after logger removal absent");