1 package Object::Remote::Role::Connector::PerlInterpreter;
6 use Object::Remote::Logging qw(:log :dlog router);
7 use Object::Remote::ModuleSender;
8 use Object::Remote::Handle;
9 use Object::Remote::Future;
10 use Scalar::Util qw(blessed weaken);
13 with 'Object::Remote::Role::Connector';
15 has module_sender => (is => 'lazy');
16 has watchdog_timeout => ( is => 'ro', required => 1, default => sub { undef });
17 has forward_env => (is => 'ro', required => 1, builder => 1);
18 has perl_command => (is => 'lazy');
19 has pid => (is => 'rwp');
20 has connection_id => (is => 'rwp');
22 #if no child_stderr file handle is specified then stderr
23 #of the child will be connected to stderr of the parent
24 has stderr => ( is => 'rw', default => sub { undef } );
26 BEGIN { router()->exclude_forwarding; }
28 sub _build_module_sender {
30 grep {blessed($_) && $_->isa('Object::Remote::ModuleLoader::Hook') }
32 return $hook ? $hook->sender : Object::Remote::ModuleSender->new;
35 #By policy object-remote does not invoke a shell
36 sub _build_perl_command {
37 my $perl_bin = 'perl';
39 if (exists $ENV{OBJECT_REMOTE_PERL_BIN}) {
40 $perl_bin = $ENV{OBJECT_REMOTE_PERL_BIN};
42 return [$perl_bin, '-'];
45 sub _build_forward_env {
47 OBJECT_REMOTE_PERL_BIN
48 OBJECT_REMOTE_LOG_LEVEL OBJECT_REMOTE_LOG_FORMAT OBJECT_REMOTE_LOG_SELECTIONS
49 OBJECT_REMOTE_LOG_FORWARDING
53 around connect => sub {
54 my ($orig, $self) = (shift, shift);
55 my $f = $self->$start::start($orig => @_);
59 $self->_setup_watchdog_reset($conn);
60 my $sub = $conn->remote_sub('Object::Remote::Logging::init_remote_logging');
61 $sub->('Object::Remote::Logging', router => router(), connection_id => $conn->_id);
62 Object::Remote::Handle->new(
64 class => 'Object::Remote::ModuleLoader',
65 args => { module_sender => $self->module_sender }
67 require Object::Remote::Prompt;
68 Object::Remote::Prompt::maybe_set_prompt_command_on($conn);
74 sub final_perl_command { shift->perl_command }
78 my $given_stderr = $self->stderr;
82 s/\n/ /g; "invoking connection to perl interpreter using command line: $_"
83 } @{$self->final_perl_command};
85 if (defined($given_stderr)) {
86 #if the stderr data goes to an existing file handle
87 #an anonymous file handle is required
88 #as the other half of a pipe style file handle pair
89 #so the file handles can go into the run loop
90 $foreign_stderr = gensym();
92 #if no file handle has been specified
93 #for the child's stderr then connect
94 #the child stderr to the parent stderr
95 $foreign_stderr = ">&STDERR";
102 @{$self->final_perl_command},
103 ) or die "Failed to run perl at '$_[0]': $!";
105 $self->_set_pid($pid);
107 if (defined($given_stderr)) {
108 Dlog_debug { "Child process STDERR is being handled via run loop" };
110 Object::Remote->current_loop
112 handle => $foreign_stderr,
113 on_read_ready => sub {
115 my $len = sysread($foreign_stderr, $buf, 32768);
116 if (!defined($len) or $len == 0) {
117 log_trace { "Got EOF or error on child stderr, removing from watcher" };
118 $self->stderr(undef);
119 Object::Remote->current_loop->unwatch_io(
120 handle => $foreign_stderr,
124 Dlog_trace { "got $len characters of stderr data for connection" };
125 print $given_stderr $buf or die "could not send stderr data: $!";
131 return ($foreign_stdin, $foreign_stdout, $pid);
136 my ($foreign_stdin, $foreign_stdout, $pid) = $self->_start_perl(@_);
137 my $to_send = $self->fatnode_text;
138 log_debug { my $len = length($to_send); "Sending contents of fat node to remote node; size is '$len' characters" };
139 Object::Remote->current_loop
141 handle => $foreign_stdin,
142 on_write_ready => sub {
143 my $len = syswrite($foreign_stdin, $to_send, 32768);
145 substr($to_send, 0, $len) = '';
147 # if the stdin went away, we'll never get Shere
148 # so it's not a big deal to simply give up on !defined
149 if (!defined($len) or 0 == length($to_send)) {
150 log_trace { "Got EOF or error when writing fatnode data to filehandle, unwatching it" };
151 Object::Remote->current_loop
153 handle => $foreign_stdin,
157 log_trace { "Sent $len bytes of fatnode data to remote side" };
161 return ($foreign_stdin, $foreign_stdout, $pid);
164 sub _setup_watchdog_reset {
165 my ($self, $conn) = @_;
168 return unless $self->watchdog_timeout;
170 Dlog_trace { "Creating Watchdog management timer for connection id $_" } $conn->_id;
174 $timer_id = Object::Remote->current_loop->watch_time(
175 every => $self->watchdog_timeout / 3,
177 unless(defined($conn)) {
178 log_warn { "Weak reference to connection in Watchdog was lost, terminating update timer $timer_id" };
179 Object::Remote->current_loop->unwatch_time($timer_id);
183 unless($conn->is_valid) {
184 log_warn { "Watchdog timer found an invalid connection, removing the timer" };
185 Object::Remote->current_loop->unwatch_time($timer_id);
189 Dlog_trace { "Reseting Watchdog for connection id $_" } $conn->_id;
190 #we do not want to block in the run loop so send the
191 #update off and ignore any result, we don't need it
193 $conn->send_class_call(0, 'Object::Remote::WatchDog', 'reset');
197 $conn->on_close->on_ready(sub {
198 log_debug { "Removing watchdog for connection that is now closed" };
199 Object::Remote->current_loop->unwatch_time($timer_id);
205 my $connection_timeout = $self->timeout;
206 my $watchdog_timeout = $self->watchdog_timeout;
209 require Object::Remote::FatNode;
211 if (defined($connection_timeout)) {
212 $text .= "alarm($connection_timeout);\n";
215 if (defined($watchdog_timeout)) {
216 $text .= "my \$WATCHDOG_TIMEOUT = $watchdog_timeout;\n";
218 $text .= "my \$WATCHDOG_TIMEOUT = undef;\n";
221 $text .= $self->_create_env_forward(@{$self->forward_env});
223 #Action at a distance but at least it's not spooky - the logging
224 #system needs to know if a node is remote but there is a period
225 #during init where the remote connection information has not been
226 #setup on the remote side yet so this flag allows a graceful
227 #degredation to happen
228 $text .= '$Object::Remote::FatNode::REMOTE_NODE = "1";' . "\n";
231 $INC{'Object/Remote/FatNode.pm'} = __FILE__;
232 $Object::Remote::FatNode::DATA = <<'ENDFAT';
234 $text .= do { no warnings 'once'; $Object::Remote::FatNode::DATA };
237 eval $Object::Remote::FatNode::DATA;
241 $text .= "__END__\n";
245 sub _create_env_forward {
246 my ($self, @env_names) = @_;
249 foreach my $name (@env_names) {
250 next unless exists $ENV{$name};
251 my $value = $ENV{$name};
253 if(defined($value)) {
259 $code .= "\$ENV{'$name'} = $value;\n";
269 Object::Remote::Role::Connector::PerlInterpreter - Role for connections to a Perl interpreter
276 perl_command => [qw(nice -n 10 perl -)],
277 watchdog_timeout => 120, stderr => \*STDERR,
280 my $local_connection = Object::Remote->connect('-', %opts);
281 my $hostname = Sys::Hostname->can::on($remote, 'hostname');
285 This is the role that supports connections to a Perl interpreter that is executed in a
286 different process. The new Perl interpreter can be either on the local or a remote machine
287 and is configurable via arguments passed to the constructor.
291 Inherits arguments from L<Object::Remote::Role::Connector> and provides the
298 By default the Perl interpeter will be executed as "perl -" but this can be changed by
299 providing an array reference as the value to the perl_command attribute during construction.
303 If this value is defined then it will be used as the file handle that receives the output
304 of STDERR from the Perl interpreter process and I/O will be performed by the run loop in a
305 non-blocking way. If the value is undefined then STDERR of the remote process will be connected
306 directly to STDERR of the local process with out the run loop managing I/O. The default value
309 There are a few ways to use this feature. By default the behavior is to form one unified STDERR
310 across all of the Perl interpreters including the local one. For small scale and quick operation
311 this offers a predictable and easy to use way to get at error messages generated anywhere. If
312 the local Perl interpreter crashes then the remote Perl interpreters still have an active STDERR
313 and it is possible to still receive output from them. This is generally a good thing but can
316 When using a file handle as the output for STDERR once the local Perl interpreter is no longer
317 running there is no longer a valid STDERR for the remote interpreters to send data to. This means
318 that it is no longer possible to receive error output from the remote interpreters and that the
319 shell will start to kill off the child processes. Passing a reference to STDERR for the local
320 interpreter (as the SYNOPSIS shows) causes the run loop to manage I/O, one unified STDERR for
321 all Perl interpreters that ends as soon as the local interpreter process does, and the shell will
322 start killing children when the local interpreter exits.
324 It is also possible to pass in a file handle that has been opened for writing. This would be
325 useful for logging the output of the remote interpreter directly into a dedicated file.
327 =item watchdog_timeout
329 If this value is defined then it will be used as the number of seconds the watchdog will wait
330 for an update before it terminates the Perl interpreter process. The default value is undefined
331 and will not use the watchdog. See C<Object::Remote::Watchdog> for more information.
339 =item C<Object::Remote>