From: Tyler Riddle Date: Mon, 12 Nov 2012 20:28:56 +0000 (-0800) Subject: change logging bootstrap to report uninit remote logging metadata; set flag that... X-Git-Tag: v0.003001_01~63 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FObject-Remote.git;a=commitdiff_plain;h=f1d7083568d3d8322a66f9c1265ef326999c5a23 change logging bootstrap to report uninit remote logging metadata; set flag that is true when perl interpreter is running remotely; clean up some whitespace --- diff --git a/lib/Object/Remote/FatNode.pm b/lib/Object/Remote/FatNode.pm index 819b9a5..4bafdcf 100644 --- a/lib/Object/Remote/FatNode.pm +++ b/lib/Object/Remote/FatNode.pm @@ -6,7 +6,7 @@ use B qw(perlstring); my @exclude_mods = qw(XSLoader.pm DynaLoader.pm); #used by t/watchdog_fatnode -our $INHIBIT_RUN_NODE = 0; +our $INHIBIT_RUN_NODE = 0; sub stripspace { my ($text) = @_; diff --git a/lib/Object/Remote/Logging.pm b/lib/Object/Remote/Logging.pm index 6446ebc..45a41de 100644 --- a/lib/Object/Remote/Logging.pm +++ b/lib/Object/Remote/Logging.pm @@ -115,7 +115,16 @@ sub init_logging { $format = "[%l %r] %s" unless defined $format; $selections = __PACKAGE__ unless defined $selections; %controller_should_log = _parse_selections($selections); - + + { + no warnings 'once'; + if (defined $Object::Remote::FatNode::REMOTE_NODE) { + #the connection id for the remote node comes in later + #as the controlling node inits remote logging + router()->_remote_metadata({ connection_id => undef }); + } + } + my $logger = Object::Remote::Logging::Logger->new( min_level => lc($level), format => $format, level_names => Object::Remote::Logging::arg_levels(), @@ -137,10 +146,10 @@ sub init_logging { #this is invoked by the controlling node #on the remote nodes -sub init_logging_forwarding { +sub init_remote_logging { my ($self, %controller_info) = @_; - router()->_remote_metadata({ connection_id => $controller_info{connection_id} }); + 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 diff --git a/lib/Object/Remote/Logging/Logger.pm b/lib/Object/Remote/Logging/Logger.pm index e53dbf3..fb05fb8 100644 --- a/lib/Object/Remote/Logging/Logger.pm +++ b/lib/Object/Remote/Logging/Logger.pm @@ -112,8 +112,10 @@ sub _render_time { sub _render_remote { my ($self, $remote) = @_; - return 'local' if ! defined $remote || ! defined $remote->{connection_id}; - return 'remote #' . $remote->{connection_id}; + return 'local' unless defined $remote; + my $conn_id = $remote->{connection_id}; + $conn_id = '(uninit)' unless defined $conn_id; + return "remote #$conn_id"; } sub _render_log { diff --git a/lib/Object/Remote/Role/Connector.pm b/lib/Object/Remote/Role/Connector.pm index a4bce2e..747341c 100644 --- a/lib/Object/Remote/Role/Connector.pm +++ b/lib/Object/Remote/Role/Connector.pm @@ -45,10 +45,10 @@ sub connect { ->watch_time( after => $self->timeout, code => sub { - Dlog_trace { "Connection timeout timer has fired for child pid '$child_pid'; is_ready: $_" } $f->is_ready; + Dlog_trace {"Connection timeout timer has fired for child pid '$child_pid'; is_ready: $_" } $f->is_ready; unless($f->is_ready) { log_warn { "Connection with child pid '$child_pid' has timed out" }; - $f->fail("Connection timed out") unless $f->is_ready; + $f->fail("Connection timed out") unless $f->is_ready; } undef($channel); diff --git a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm index 3af5712..16bf6a6 100644 --- a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm +++ b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm @@ -14,10 +14,12 @@ use Moo::Role; with 'Object::Remote::Role::Connector'; has module_sender => (is => 'lazy'); -has ulimit => ( is => 'ro' ); -has nice => ( is => 'ro' ); -has watchdog_timeout => ( is => 'ro', required => 1, default => sub { undef } ); +has ulimit => ( is => 'ro'); +has nice => ( is => 'ro'); +has watchdog_timeout => ( is => 'ro', required => 1, default => sub { undef }); has perl_command => (is => 'lazy'); +has pid => (is => 'rwp'); +has connection_id => (is => 'rwp'); #if no child_stderr file handle is specified then stderr #of the child will be connected to stderr of the parent @@ -55,15 +57,14 @@ sub _build_perl_command { return [ 'bash', '-c', $shell_code ]; } - around connect => sub { my ($orig, $self) = (shift, shift); my $f = $self->$start::start($orig => @_); return future { $f->on_done(sub { my ($conn) = $f->get; - $self->_setup_watchdog_reset($conn); - my $sub = $conn->remote_sub('Object::Remote::Logging::init_logging_forwarding'); + $self->_setup_watchdog_reset($conn); + my $sub = $conn->remote_sub('Object::Remote::Logging::init_remote_logging'); $sub->('Object::Remote::Logging', router => router(), connection_id => $conn->_id); Object::Remote::Handle->new( connection => $conn, @@ -108,6 +109,8 @@ sub _start_perl { @{$self->final_perl_command}, ) or die "Failed to run perl at '$_[0]': $!"; + $self->_set_pid($pid); + if (defined($given_stderr)) { Dlog_debug { "Child process STDERR is being handled via run loop" }; @@ -139,7 +142,7 @@ sub _open2_for { my $self = shift; my ($foreign_stdin, $foreign_stdout, $pid) = $self->_start_perl(@_); my $to_send = $self->fatnode_text; - log_debug { my $len = length($to_send); "Sending contents of fat node to remote node; size is '$len' characters" }; + log_debug { my $len = length($to_send); "Sending contents of fat node to remote node; size is '$len' characters" }; Object::Remote->current_loop ->watch_io( handle => $foreign_stdin, @@ -206,11 +209,13 @@ sub fatnode_text { } if (defined($watchdog_timeout)) { - $text .= "my \$WATCHDOG_TIMEOUT = $watchdog_timeout;\n"; + $text .= "my \$WATCHDOG_TIMEOUT = $watchdog_timeout;\n"; } else { $text .= "my \$WATCHDOG_TIMEOUT = undef;\n"; } + $text .= '$Object::Remote::FatNode::REMOTE_NODE = "1";' . "\n"; + $text .= <<'END'; $INC{'Object/Remote/FatNode.pm'} = __FILE__; $Object::Remote::FatNode::DATA = <<'ENDFAT';