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=6e74019d3b17c879fe5c4a0e7d2e7cefca3cf388;hp=0cc02d75c8a4ee488aee311dac02f0873c26b70c;hb=8c3529062a426181861d58ee59fb8f10e0be68e5;hpb=b8176a97bbde19ddf305754cf2de7331e1aee19a diff --git a/lib/Object/Remote/Logging.pm b/lib/Object/Remote/Logging.pm index 0cc02d7..6e74019 100644 --- a/lib/Object/Remote/Logging.pm +++ b/lib/Object/Remote/Logging.pm @@ -46,23 +46,23 @@ sub before_import { } sub _parse_selections { - my ($selections_string) = @_; - my %log_ok; + 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; - } + #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; + return %log_ok; } #this is invoked on all nodes @@ -70,9 +70,22 @@ 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 $test_logging = $ENV{OBJECT_REMOTE_TEST_LOGGER}; my %controller_should_log; + + unless (defined $ENV{OBJECT_REMOTE_LOG_FORWARDING} && $ENV{OBJECT_REMOTE_LOG_FORWARDING} ne '') { + $ENV{OBJECT_REMOTE_LOG_FORWARDING} = 1; + } + + if ($test_logging) { + require Object::Remote::Logging::TestLogger; + router->connect(Object::Remote::Logging::TestLogger->new( + min_level => 'trace', max_level => 'error', + level_names => Object::Remote::Logging->arg_levels(), + )); + } - return unless defined $level; + return unless defined $level && $level ne ''; $format = "[%l %r] %s" unless defined $format; $selections = __PACKAGE__ unless defined $selections; %controller_should_log = _parse_selections($selections); @@ -111,9 +124,6 @@ sub init_remote_logging { my ($self, %controller_info) = @_; router()->_remote_metadata(\%controller_info); - #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}; } @@ -136,7 +146,7 @@ Object::Remote::Logging - Logging subsystem for Object::Remote $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 + $ENV{OBJECT_REMOTE_LOG_FORWARDING} = 0; #default 1 log_info { 'Trace log event' }; Dlog_verbose { "Debug event with Data::Dumper::Concise: $_" } { foo => 'bar' }; @@ -195,8 +205,8 @@ remote interpreter and the logger for the message is invoked in the local interp Sub-classes of Object::Remote::Logging will have log messages forwarded automatically. Loggers receive forwarded log messages exactly the same way as non-forwarded messages except a forwarded message includes extra metadata about the remote interpreter. Log -forwarding is not currently enabled by default; to enable it set the -OBJECT_REMOTE_LOG_FORWARDING environment variable to 1. See L. +forwarding is enabled by default but comes with a performance hit; to disable it set the +OBJECT_REMOTE_LOG_FORWARDING environment variable to 0. See L. =head1 EXPORTABLE SUBROUTINES @@ -228,7 +238,7 @@ to the block as the argument list and returned from the log method as a list. Works just like log_ and Dlog_ except returns only the first argument as a scalar value. - my $beverage = log_info { "Customer ordered $_[0]" } 'Coffee'; + my $beverage = logS_info { "Customer ordered $_[0]" } 'Coffee'; =back