add pid and hostname to logging metadata; setting OBJECT_REMOTE_LOG_FORWARDING env...

diff --git a/lib/Object/Remote/Logging.pm b/lib/Object/Remote/Logging.pm
index d8bfdba..cf85e10 100644 (file)
--- a/lib/Object/Remote/Logging.pm
+++ b/lib/Object/Remote/Logging.pm
@@ -49,11 +49,9 @@ sub init_logging {
     level_names => Object::Remote::Logging::arg_levels(),
   );
 
-  #TODO check on speed of string compare against a hash with a single key
   router()->connect(sub { 
     my $controller = $_[1]->{controller};
-#    warn $controller;
-    return unless  $controller_should_log{$controller};
+    return unless  $controller_should_log{'*'} || $controller_should_log{$controller};
     #skip things from remote hosts because they log to STDERR
     #when OBJECT_REMOTE_LOG_LEVEL is in effect
     return if $_[1]->{remote}->{connection_id};
@@ -67,7 +65,7 @@ sub init_logging_forwarding {
   my ($self, %controller_info) = @_;
   
   router()->_remote_metadata({ connection_id => $controller_info{connection_id} });
-  router()->_forward_destination($controller_info{router});
+  router()->_forward_destination($controller_info{router}) if $ENV{OBJECT_REMOTE_LOG_FORWARDING};
 }
 
 1;

diff --git a/lib/Object/Remote/Logging/Logger.pm b/lib/Object/Remote/Logging/Logger.pm
index 68adaf8..e440d57 100644 (file)
--- a/lib/Object/Remote/Logging/Logger.pm
+++ b/lib/Object/Remote/Logging/Logger.pm
@@ -68,7 +68,8 @@ sub _create_format_lookup {
     r => $self->_render_remote($metadata->{object_remote}),
     s => $self->_render_log(@$content), l => $level, 
     c => $metadata->{controller}, p => $metadata->{package}, m => $method,
-    f => $metadata->{filename}, i => $metadata->{line},
+    f => $metadata->{filename}, i => $metadata->{line}, 
+    h => $metadata->{hostname}, P => $metadata->{pid},
     
   };
 }
@@ -77,7 +78,7 @@ sub _get_format_var_value {
   my ($self, $name, $data) = @_;
   my $val = $data->{$name};
   return $val if defined $val;
-  return '';
+  return '(undefined)';
 }
 
 sub _render_time {
@@ -100,7 +101,7 @@ sub _render {
   my $var_table = $self->_create_format_lookup($level, $metadata, [@content]);
   my $template = $self->format;
   
-  $template =~ s/%([\w])/$self->_get_format_var_value($1, $var_table)/ge;
+  $template =~ s/%([\w%])/$self->_get_format_var_value($1, $var_table)/ge;
   
   chomp($template);
   $template =~ s/\n/\n /g;

diff --git a/lib/Object/Remote/Logging/Router.pm b/lib/Object/Remote/Logging/Router.pm
index 1bd62fa..2d48ca5 100644 (file)
--- a/lib/Object/Remote/Logging/Router.pm
+++ b/lib/Object/Remote/Logging/Router.pm
@@ -2,6 +2,7 @@ package Object::Remote::Logging::Router;
 
 use Moo;
 use Scalar::Util qw(weaken);
+use Sys::Hostname;
 
 with 'Log::Contextual::Role::Router';
 with 'Object::Remote::Role::LogForwarder';
@@ -71,6 +72,8 @@ sub handle_log_request {
   my $caller_level = delete $metadata{caller_level};
   $metadata{object_remote} = $self->_remote_metadata;
   $metadata{timestamp} = time;
+  $metadata{pid} = $$;
+  $metadata{hostname} = hostname;
 
   my @caller_info = caller($caller_level);
   $metadata{filename} = $caller_info[1];

diff --git a/t/perl_execute.t b/t/perl_execute.t
index c710ed3..e92db59 100644 (file)
--- a/t/perl_execute.t
+++ b/t/perl_execute.t
@@ -11,22 +11,22 @@ use Object::Remote::Connector::SSH;
 my $defaults = Object::Remote::Connector::Local->new;
 
 my $normal = $defaults->final_perl_command;
-my $ulimit = Object::Remote::Connector::Local->new(ulimit => 536)->final_perl_command;
+my $ulimit = Object::Remote::Connector::Local->new(ulimit => "-v 536")->final_perl_command;
 my $nice = Object::Remote::Connector::Local->new(nice => 834)->final_perl_command;
-my $both = Object::Remote::Connector::Local->new(nice => 612, ulimit => 913)->final_perl_command;
-my $ssh = Object::Remote::Connector::SSH->new(nice => 494, ulimit => 782, ssh_to => 'testhost')->final_perl_command;
+my $both = Object::Remote::Connector::Local->new(nice => 612, ulimit => "-v 913")->final_perl_command;
+my $ssh = Object::Remote::Connector::SSH->new(nice => 494, ulimit => "-v 782", ssh_to => 'testhost')->final_perl_command;
 
-is($defaults->timeout->{after}, 10, 'Default connection timeout value is correct');
+is($defaults->timeout, 10, 'Default connection timeout value is correct');
 is($defaults->watchdog_timeout, undef, 'Watchdog is not enabled by default');
 is($defaults->nice, undef, 'Nice is not enabled by default');
 is($defaults->ulimit, undef, 'Ulimit is not enabled by default');
 is($defaults->stderr, undef, 'Child process STDERR is clone of parent process STDERR by default');
 
-is_deeply($normal, ['sh', '-c', 'perl -'], 'Default Perl interpreter arguments correct');
-is_deeply($ulimit, ['sh', '-c', 'ulimit -v 536; perl -'], 'Arguments for ulimit are correct');
-is_deeply($nice, ['sh', '-c', 'nice -n 834 perl -'], 'Arguments for nice are correct');
-is_deeply($both, ['sh', '-c', 'ulimit -v 913; nice -n 612 perl -'], 'Arguments for nice and ulimit are correct');
-is_deeply($ssh, [qw(ssh -A testhost), "sh -c 'ulimit -v 782; nice -n 494 perl -'"], "Arguments using ssh are correct");
+is_deeply($normal, ['bash', '-c', 'perl -'], 'Default Perl interpreter arguments correct');
+is_deeply($ulimit, ['bash', '-c', 'ulimit -v 536 || exit 1; perl -'], 'Arguments for ulimit are correct');
+is_deeply($nice, ['bash', '-c', 'nice -n 834 perl -'], 'Arguments for nice are correct');
+is_deeply($both, ['bash', '-c', 'ulimit -v 913 || exit 1; nice -n 612 perl -'], 'Arguments for nice and ulimit are correct');
+is_deeply($ssh, [qw(ssh -A testhost), "bash -c 'ulimit -v 782 || exit 1; nice -n 494 perl -'"], "Arguments using ssh are correct");
 
 done_testing;