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=15f4d97bba0146142fa496867f5ada2b653e2de9;hp=f5416d650de5db7b6cb930a066bf28b169276876;hb=977ec25d052fe4f70ebab44b159bb6dc11ce4240;hpb=0e090a216bf8825855f8ca70bcb7f0980b5f786d diff --git a/lib/Object/Remote/Logging.pm b/lib/Object/Remote/Logging.pm index f5416d6..15f4d97 100644 --- a/lib/Object/Remote/Logging.pm +++ b/lib/Object/Remote/Logging.pm @@ -4,7 +4,6 @@ use Moo; use Scalar::Util qw(blessed); use Object::Remote::Logging::Logger; use Exporter::Declare; -use Carp qw(carp croak); extends 'Log::Contextual'; @@ -46,23 +45,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,16 +69,20 @@ 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; + $ENV{OBJECT_REMOTE_LOG_FORWARDING} = 0; + } + + 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 && $level ne ''; - $format = "[%l %r] %s" unless defined $format; - $selections = __PACKAGE__ unless defined $selections; - %controller_should_log = _parse_selections($selections); { no warnings 'once'; @@ -90,22 +93,29 @@ sub init_logging { } } + return unless defined $level && $level ne ''; + + $format = "[%l %r] %s" unless defined $format; + $selections = __PACKAGE__ unless defined $selections; + %controller_should_log = _parse_selections($selections); + my $logger = Object::Remote::Logging::Logger->new( min_level => lc($level), format => $format, level_names => Object::Remote::Logging::arg_levels(), ); router()->connect(sub { - my $controller = $_[1]->{controller}; + my $controller = $_[1]->{exporter}; my $will_log = $controller_should_log{$controller}; + my $remote_info = $_[1]->{object_remote}; $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}; - $logger + return if $remote_info->{forwarded}; + return $logger; }); } @@ -196,8 +206,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 enabled by default but comes with a performance hit; to disable it set the -OBJECT_REMOTE_LOG_FORWARDING environment variable to 0. See L. +forwarding is disabled by default because it comes with a performance hit; to enable +it set the OBJECT_REMOTE_LOG_FORWARDING environment variable to 1. =head1 EXPORTABLE SUBROUTINES