X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FObject%2FRemote%2FRole%2FConnector%2FPerlInterpreter.pm;h=5406428295b1e59cd2b007b9a472f2b6f6adf343;hb=b1f10b7944d395e404beb995813271d857d143f7;hp=31e13e2259cd96e4c3339e719c83a1eb015f4b64;hpb=b9baacc29444767f88abdbca93f65c8bd5e5a676;p=scpubgit%2FObject-Remote.git diff --git a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm index 31e13e2..5406428 100644 --- a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm +++ b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm @@ -3,17 +3,21 @@ package Object::Remote::Role::Connector::PerlInterpreter; use IPC::Open2; use IPC::Open3; use IO::Handle; +use Symbol; use Object::Remote::Logging qw( :log :dlog ); use Object::Remote::ModuleSender; use Object::Remote::Handle; use Object::Remote::Future; use Scalar::Util qw(blessed weaken); use Moo::Role; -use Symbol; 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 perl_command => (is => 'lazy'); #if no child_stderr file handle is specified then stderr #of the child will be connected to stderr of the parent @@ -26,17 +30,24 @@ sub _build_module_sender { return $hook ? $hook->sender : Object::Remote::ModuleSender->new; } -has perl_command => (is => 'lazy'); -has watchdog_timeout => ( is => 'ro', required => 1, default => sub { 0 } ); - -#TODO convert nice value into optional feature enabled by -#setting value of attribute -#ulimit of ~500 megs of v-ram -#TODO only works with ssh with quotes but only works locally -#with out quotes -sub _build_perl_command {[ 'sh -c "ulimit -v 200000; nice -n 15 perl -"' ] } -#sub _build_perl_command { [ 'perl', '-' ] } -#sub _build_perl_command { [ 'cat' ] } +sub _build_perl_command { + my ($self) = @_; + my $nice = $self->nice; + my $ulimit = $self->ulimit; + my $shell_code = ''; + + if (defined($ulimit)) { + $shell_code .= "ulimit -v $ulimit; "; + } + + if (defined($nice)) { + $shell_code .= "nice -n $nice "; + } + + $shell_code .= 'perl -'; + + return [ 'sh', '-c', $shell_code ]; +} around connect => sub { my ($orig, $self) = (shift, shift); @@ -70,7 +81,7 @@ sub _start_perl { if (defined($given_stderr)) { #if the stderr data goes to an existing file handle - #an need an anonymous file handle is required + #an anonymous file handle is required #as the other half of a pipe style file handle pair #so the file handles can go into the run loop $foreign_stderr = gensym(); @@ -89,9 +100,8 @@ sub _start_perl { ) or die "Failed to run perl at '$_[0]': $!"; if (defined($given_stderr)) { - log_warn { "using experimental cat for child stderr" }; + Dlog_debug { "Child process STDERR is being handled via run loop" }; - #TODO refactor if this solves the problem Object::Remote->current_loop ->watch_io( handle => $foreign_stderr, @@ -154,7 +164,9 @@ sub _setup_watchdog_reset { return unless $self->watchdog_timeout; Dlog_trace { "Creating Watchdog management timer for connection id $_" } $conn->_id; - + + weaken($conn); + $timer_id = Object::Remote->current_loop->watch_time( every => $self->watchdog_timeout / 3, code => sub { @@ -164,15 +176,13 @@ sub _setup_watchdog_reset { return; } - Dlog_debug { "Reseting Watchdog for connection id $_" } $conn->_id; + Dlog_trace { "Reseting Watchdog for connection id $_" } $conn->_id; #we do not want to block in the run loop so send the #update off and ignore any result, we don't need it #anyway $conn->send_class_call(0, 'Object::Remote::WatchDog', 'reset'); } - ); - - $conn->on_close->on_done(sub { Object::Remote->current_loop->unwatch_time($timer_id) }); + ); } sub fatnode_text { @@ -181,14 +191,13 @@ sub fatnode_text { require Object::Remote::FatNode; - $text = "my \$WATCHDOG_TIMEOUT = '" . $self->watchdog_timeout . "';\n"; - - if (my $duration = $self->watchdog_timeout) { + if (defined($self->watchdog_timeout)) { + $text = "my \$WATCHDOG_TIMEOUT = '" . $self->watchdog_timeout . "';\n"; $text .= "alarm(\$WATCHDOG_TIMEOUT);\n"; + } else { + $text = "my \$WATCHDOG_TIMEOUT = undef;\n"; } - - $text .= 'BEGIN { $ENV{OBJECT_REMOTE_DEBUG} = 1 }'."\n" - if $ENV{OBJECT_REMOTE_DEBUG}; + $text .= <<'END'; $INC{'Object/Remote/FatNode.pm'} = __FILE__; $Object::Remote::FatNode::DATA = <<'ENDFAT';