X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FObject-Remote.git;a=blobdiff_plain;f=lib%2FObject%2FRemote%2FConnection.pm;h=77fc2d74b8ff416048e3c06e7290634f593b4006;hp=307cde303ae48e6c1eb90d621e978e4608fd5855;hb=5ccce2d5c1fb651f83c73c811069003e4a591a53;hpb=eb351344773af82344bd550ffd5a8814b816cfeb diff --git a/lib/Object/Remote/Connection.pm b/lib/Object/Remote/Connection.pm index 307cde3..77fc2d7 100644 --- a/lib/Object/Remote/Connection.pm +++ b/lib/Object/Remote/Connection.pm @@ -21,13 +21,14 @@ use Carp qw(croak); BEGIN { router()->exclude_forwarding } END { - log_debug { "Killing all child processes in the process group" }; - - #FIXME update along with setpgrp() to not use a process - #group anymore + our %child_pids; + + log_trace { "END handler is being invoked in " . __PACKAGE__ }; - #send SIGINT to the process group for our children - kill(1, -2); + foreach(keys(%child_pids)) { + log_debug { "Killing child process '$_'" }; + kill('TERM', $_); + } } has _id => ( is => 'ro', required => 1, default => sub { our $NEXT_CONNECTION_ID++ } ); @@ -89,27 +90,30 @@ has _json => ( after BUILD => sub { my ($self) = @_; my $pid = $self->child_pid; - - unless (defined $pid) { - log_trace { "After BUILD invoked for connection but there was no pid" }; - return; - } - - log_trace { "Setting process group of child process '$pid'" }; - - #FIXME moving things into a process group has side effects for - #users of the library - move to a list - setpgrp($self->child_pid, 1); + our %child_pids; + return unless defined $pid; + $child_pids{$pid} = 1; + return; }; sub BUILD { } sub is_valid { my ($self) = @_; - my $closed = $self->on_close->is_ready; + my $valid = ! $self->on_close->is_ready; - log_trace { "Connection closed: $closed" }; - return ! $closed; + log_trace { + my $id = $self->_id; + my $text; + if ($valid) { + $text = 'yes'; + } else { + $text = 'no'; + } + "Connection '$id' is valid: '$text'" + }; + + return $valid; } sub _fail_outstanding { @@ -132,6 +136,7 @@ sub _fail_outstanding { sub _install_future_handlers { my ($self, $f) = @_; + our %child_pids; Dlog_trace { "Installing handlers into future for connection $_" } $self->_id; weaken($self); $f->on_done(sub { @@ -152,6 +157,8 @@ sub _install_future_handlers { "Remote Perl interpreter exited with value '$exit_value'" }; } + + delete $child_pids{$pid}; }); return $f; }; @@ -269,7 +276,7 @@ sub connect { sub remote_sub { my ($self, $sub) = @_; my ($pkg, $name) = $sub =~ m/^(.*)::([^:]+)$/; - Dlog_debug { "Invoking remote sub '$sub' for connection $_" } $self->_id; + Dlog_debug { "Invoking remote sub '$sub' for connection '$_'" } $self->_id; return await_future($self->send_class_call(0, $pkg, can => $name)); }