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=3b4adfc70bd285a4f5bfa2656d3043ca03713aea;hp=77fc2d74b8ff416048e3c06e7290634f593b4006;hb=de9062cfef7f98d0efc01b114328959f2f84ada4;hpb=5ccce2d5c1fb651f83c73c811069003e4a591a53 diff --git a/lib/Object/Remote/Connection.pm b/lib/Object/Remote/Connection.pm index 77fc2d7..3b4adfc 100644 --- a/lib/Object/Remote/Connection.pm +++ b/lib/Object/Remote/Connection.pm @@ -22,9 +22,9 @@ BEGIN { router()->exclude_forwarding } END { our %child_pids; - + log_trace { "END handler is being invoked in " . __PACKAGE__ }; - + foreach(keys(%child_pids)) { log_debug { "Killing child process '$_'" }; kill('TERM', $_); @@ -46,11 +46,11 @@ has read_channel => ( is => 'ro', required => 1, trigger => sub { my ($self, $ch) = @_; - my $id = $self->_id; + my $id = $self->_id; Dlog_trace { "trigger for read_channel has been invoked for connection $id; file handle is $_" } $ch->fh; weaken($self); $ch->on_line_call(sub { $self->_receive(@_) }); - $ch->on_close_call(sub { + $ch->on_close_call(sub { log_trace { "invoking 'done' on on_close handler for connection id '$id'" }; $self->on_close->done(@_); }); @@ -101,7 +101,7 @@ sub BUILD { } sub is_valid { my ($self) = @_; my $valid = ! $self->on_close->is_ready; - + log_trace { my $id = $self->_id; my $text; @@ -112,15 +112,15 @@ sub is_valid { } "Connection '$id' is valid: '$text'" }; - + return $valid; } sub _fail_outstanding { my ($self, $error) = @_; my $outstanding = $self->outstanding_futures; - - Dlog_debug { + + Dlog_debug { sprintf "Failing %i outstanding futures with '$error'", scalar(keys(%$outstanding)) }; @@ -157,10 +157,10 @@ sub _install_future_handlers { "Remote Perl interpreter exited with value '$exit_value'" }; } - + delete $child_pids{$pid}; }); - return $f; + return $f; }; sub _id_to_remote_object { @@ -216,9 +216,9 @@ sub _build__json { } sub _load_if_possible { - my ($class) = @_; + my ($class) = @_; - use_module($class); + use_module($class); if ($@) { log_debug { "Attempt at loading '$class' failed with '$@'" }; @@ -233,7 +233,7 @@ BEGIN { Object::Remote::Connector::LocalSudo Object::Remote::Connector::SSH Object::Remote::Connector::UNIX - ); + ); } sub conn_from_spec { @@ -243,7 +243,7 @@ sub conn_from_spec { return $conn; } } - + return undef; } @@ -251,11 +251,11 @@ sub new_from_spec { my ($class, $spec, @args) = @_; return $spec if blessed $spec; my $conn = $class->conn_from_spec($spec, @args); - + die "Couldn't figure out what to do with ${spec}" unless defined $conn; - - return $conn->maybe::start::connect; + + return $conn->maybe::start::connect; } sub remote_object { @@ -352,32 +352,32 @@ sub send_discard { sub _send { my ($self, $to_send) = @_; my $fh = $self->send_to_fh; - + unless ($self->is_valid) { croak "Attempt to invoke _send on a connection that is not valid"; } - + Dlog_trace { "Starting to serialize data in argument to _send for connection $_" } $self->_id; my $serialized = $self->_serialize($to_send)."\n"; Dlog_trace { my $l = length($serialized); "serialization is completed; sending '$l' characters of serialized data to $_" } $fh; - my $ret; - eval { + my $ret; + eval { #TODO this should be converted over to a non-blocking ::WriteChannel class die "filehandle is not open" unless openhandle($fh); log_trace { "file handle has passed openhandle() test; printing to it" }; $ret = print $fh $serialized; die "print was not successful: $!" unless defined $ret }; - + if ($@) { Dlog_debug { "exception encountered when trying to write to file handle $_: $@" } $fh; my $error = $@; chomp($error); $self->on_close->done("could not write to file handle: $error") unless $self->on_close->is_ready; - return; + return; } - - return $ret; + + return $ret; } sub _serialize { @@ -419,14 +419,14 @@ sub _deobjectify { if ($ref eq 'HASH') { my $tied_to = tied(%$data); if(defined($tied_to)) { - return +{__remote_tied_hash__ => $self->_local_object_to_id($tied_to)}; + return +{__remote_tied_hash__ => $self->_local_object_to_id($tied_to)}; } else { return +{ map +($_ => $self->_deobjectify($data->{$_})), keys %$data }; } } elsif ($ref eq 'ARRAY') { my $tied_to = tied(@$data); if (defined($tied_to)) { - return +{__remote_tied_array__ => $self->_local_object_to_id($tied_to)}; + return +{__remote_tied_array__ => $self->_local_object_to_id($tied_to)}; } else { return [ map $self->_deobjectify($_), @$data ]; } @@ -513,79 +513,25 @@ sub _invoke { Object::Remote::Connection - An underlying connection for L use Object::Remote; - - my %opts = ( - nice => '10', ulimit => '-v 400000', - watchdog_timeout => 120, stderr => \*STDERR, - ); - + my $local = Object::Remote->connect('-'); - my $remote = Object::Remote->connect('myserver', nice => 5); - my $remote_user = Object::Remote->connect('user@myserver', %opts); + my $remote = Object::Remote->connect('myserver'); + my $remote_user = Object::Remote->connect('user@myserver'); my $local_sudo = Object::Remote->connect('user@'); - + #$remote can be any other connection object my $hostname = Sys::Hostname->can::on($remote, 'hostname'); - -=head1 DESCRIPTION - -This is the class that supports connections to a Perl interpreter that is executed in a -different process. The new Perl interpreter can be either on the local or a remote machine -and is configurable via arguments passed to the constructor. - -=head1 ARGUMENTS - -=over 4 - -=item nice - -If this value is defined then it will be used as the nice value of the Perl process when it -is started. The default is the undefined value and will not nice the process. - -=item stderr - -If this value is defined then it will be used as the file handle that receives the output -of STDERR from the Perl interpreter process and I/O will be performed by the run loop in a -non-blocking way. If the value is undefined then STDERR of the remote process will be connected -directly to STDERR of the local process with out the run loop managing I/O. The default value -is undefined. -There are a few ways to use this feature. By default the behavior is to form one unified STDERR -across all of the Perl interpreters including the local one. For small scale and quick operation -this offers a predictable and easy to use way to get at error messages generated anywhere. If -the local Perl interpreter crashes then the remote Perl interpreters still have an active STDERR -and it is possible to still receive output from them. This is generally a good thing but can -cause issues. - -When using a file handle as the output for STDERR once the local Perl interpreter is no longer -running there is no longer a valid STDERR for the remote interpreters to send data to. This means -that it is no longer possible to receive error output from the remote interpreters and that the -shell will start to kill off the child processes. Passing a reference to STDERR for the local -interpreter (as the SYNOPSIS shows) causes the run loop to manage I/O, one unified STDERR for -all Perl interpreters that ends as soon as the local interpreter process does, and the shell will -start killing children when the local interpreter exits. - -It is also possible to pass in a file handle that has been opened for writing. This would be -useful for logging the output of the remote interpreter directly into a dedicated file. - -=item ulimit - -If this string is defined then it will be passed unmodified as the arguments to ulimit when -the Perl process is started. The default value is the undefined value and will not limit the -process in any way. - -=item watchdog_timeout - -If this value is defined then it will be used as the number of seconds the watchdog will wait -for an update before it terminates the Perl interpreter process. The default value is undefined -and will not use the watchdog. See C for more information. +=head1 DESCRIPTION -=back +This is the class that supports connections to remote objects. =head1 SEE ALSO =over 4 +=item C + =item C =back