X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FObject-Remote.git;a=blobdiff_plain;f=lib%2FObject%2FRemote%2FLogging.pm;h=1c45b45eae1ebda0af967b078133219c049a2e33;hp=7e030ff49a5c8108d278ee89431e0a2876ed6cc1;hb=293fb1ee44fb32ff692278802149f42a5e391197;hpb=f21127fd8c611eee83f769422168bb7bf3b25f0a diff --git a/lib/Object/Remote/Logging.pm b/lib/Object/Remote/Logging.pm index 7e030ff..1c45b45 100644 --- a/lib/Object/Remote/Logging.pm +++ b/lib/Object/Remote/Logging.pm @@ -69,26 +69,54 @@ sub before_import { caller_level => 1, level => $level, }, $code) }; - warn "could not deliver log event during Flog_$level: $@" if defined $@; + warn "could not deliver log event during Flog_$level: $@" if $@; eval { carp $code->() }; - warn "could not emit warning during Flog_$level: $@" if defined $@; + warn "could not emit warning during Flog_$level: $@" if $@; exit($exit_value); }); } } } +sub _parse_selections { + my ($selections_string) = @_; + my %log_ok; + + #example string: + #" * -Object::Remote::Logging Foo::Bar::Baz " + foreach(split(/\s+/, $selections_string)) { + next if $_ eq ''; + if ($_ eq '*') { + $log_ok{$_} = 1; + } elsif (s/^-//) { + $log_ok{$_} = 0; + } else { + $log_ok{$_} = 1; + } + } + + return %log_ok; +} + #this is invoked on all nodes sub init_logging { my $level = $ENV{OBJECT_REMOTE_LOG_LEVEL}; my $format = $ENV{OBJECT_REMOTE_LOG_FORMAT}; my $selections = $ENV{OBJECT_REMOTE_LOG_SELECTIONS}; my %controller_should_log; - + + #TODO how can a third party module perform an action when a new + #interpreter is built on a remote node with out requiring support + #for that third party module baked into object::remote? + eval { + require Log::Any::Adapter; + Log::Any::Adapter->set('+Object::Remote::Logging::LogAnyInjector'); + }; + return unless defined $level; $format = "[%l %r] %s" unless defined $format; $selections = __PACKAGE__ unless defined $selections; - %controller_should_log = map { $_ => 1 } split(' ', $selections); + %controller_should_log = _parse_selections($selections); my $logger = Object::Remote::Logging::Logger->new( min_level => lc($level), format => $format, @@ -97,7 +125,11 @@ sub init_logging { router()->connect(sub { my $controller = $_[1]->{controller}; - return unless $controller_should_log{'*'} || $controller_should_log{$controller}; + my $will_log = $controller_should_log{$controller}; + + $will_log = $controller_should_log{'*'} unless defined $will_log; + + return unless $will_log; #skip things from remote hosts because they log to STDERR #when OBJECT_REMOTE_LOG_LEVEL is in effect return if $_[1]->{remote}->{connection_id}; @@ -111,6 +143,9 @@ sub init_logging_forwarding { my ($self, %controller_info) = @_; router()->_remote_metadata({ connection_id => $controller_info{connection_id} }); + #TODO having an instance of an object in the remote interpreter causes it to hang + #on exit intermitently or leave a zombie laying around frequently - not a bug limited + #to log forwarding router()->_forward_destination($controller_info{router}) if $ENV{OBJECT_REMOTE_LOG_FORWARDING}; } @@ -132,6 +167,7 @@ Object::Remote::Logging - Logging subsystem for Object::Remote $ENV{OBJECT_REMOTE_LOG_LEVEL} = 'trace'; #or other level name $ENV{OBJECT_REMOTE_LOG_FORMAT} = '%l %t: %p::%m %s'; #and more $ENV{OBJECT_REMOTE_LOG_SELECTIONS} = 'Object::Remote::Logging Some::Other::Subclass'; + $ENV{OBJECT_REMOTE_LOG_SELECTIONS} = '* -Object::Remote::Logging'; $ENV{OBJECT_REMOTE_LOG_FORWARDING} = 0 || 1; #default 0 log_info { 'Trace log event' }; @@ -174,8 +210,11 @@ automatically be enabled via OBJECT_REMOTE_LOG_LEVEL and formated with OBJECT_REMOTE_LOG_FORMAT but those additional log messages are not sent to STDERR. By setting the OBJECT_REMOTE_LOG_SELECTIONS environment variable to a list of class names seperated by spaces then logs generated by packages that use those classes -will be sent to STDERR. This is also a configuration item that is forwarded to the -remote interpreters so all logging is consistent. +will be sent to STDERR. If the asterisk character (*) is used in the place of a class +name then all class names will be selected by default instead of ignored. An individual +class name can be turned off by prefixing the name with a hypen character (-). This is +also a configuration item that is forwarded to the remote interpreters so all logging +is consistent. Regardless of OBJECT_REMOTE_LOG_LEVEL the logging system is still active and loggers can access the stream of log messages to format and output them. Internally @@ -242,8 +281,8 @@ value will default to 1 or can be specified as an argument. =head1 LEVEL NAMES -Object::Remote uses an ordered list of log level names with the minimum level -first and the maximum level last. The list of level names can be accessed via +Object::Remote uses an ordered list of log level names with the lowest level +first and the highest level last. The list of level names can be accessed via the arg_levels method which is exportable to the consumer of this class. The log level names are: