X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FObject-Remote.git;a=blobdiff_plain;f=lib%2FObject%2FRemote%2FRole%2FConnector%2FPerlInterpreter.pm;h=16bf6a6db81405a898f743965266319f3ac5ca1f;hp=670ad736fe7abfc870e43541d8b6f91e1ab95e4c;hb=f1d7083568d3d8322a66f9c1265ef326999c5a23;hpb=0fe333eb337345ecc842a14bf738b5db837936b0 diff --git a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm index 670ad73..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 @@ -45,9 +47,9 @@ sub _build_perl_command { $shell_code .= "nice -n $nice "; } - if (defined($ENV{OBJECT_REMOTE_PERL_PATH})) { - log_debug { "Using OBJECT_REMOTE_PERL_PATH environment variable as perl path" }; - $perl_path = $ENV{OBJECT_REMOTE_PERL_PATH}; + if (defined($ENV{OBJECT_REMOTE_PERL_BIN})) { + log_debug { "Using OBJECT_REMOTE_PERL_BIN environment variable as perl path" }; + $perl_path = $ENV{OBJECT_REMOTE_PERL_BIN}; } $shell_code .= $perl_path . ' -'; @@ -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, @@ -84,7 +85,9 @@ sub _start_perl { my $given_stderr = $self->stderr; my $foreign_stderr; - Dlog_debug { "invoking connection to perl interpreter using command line: $_" } @{$self->final_perl_command}; + Dlog_verbose { + s/\n/ /g; "invoking connection to perl interpreter using command line: $_" + } @{$self->final_perl_command}; if (defined($given_stderr)) { #if the stderr data goes to an existing file handle @@ -106,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" }; @@ -137,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, @@ -204,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';