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.
295 By default the Perl interpeter will be executed as "perl -" but this can be changed by
296 providing an array reference as the value to the perl_command attribute during construction.
300 If this value is defined then it will be used as the file handle that receives the output
301 of STDERR from the Perl interpreter process and I/O will be performed by the run loop in a
302 non-blocking way. If the value is undefined then STDERR of the remote process will be connected
303 directly to STDERR of the local process with out the run loop managing I/O. The default value
306 There are a few ways to use this feature. By default the behavior is to form one unified STDERR
307 across all of the Perl interpreters including the local one. For small scale and quick operation
308 this offers a predictable and easy to use way to get at error messages generated anywhere. If
309 the local Perl interpreter crashes then the remote Perl interpreters still have an active STDERR
310 and it is possible to still receive output from them. This is generally a good thing but can
313 When using a file handle as the output for STDERR once the local Perl interpreter is no longer
314 running there is no longer a valid STDERR for the remote interpreters to send data to. This means
315 that it is no longer possible to receive error output from the remote interpreters and that the
316 shell will start to kill off the child processes. Passing a reference to STDERR for the local
317 interpreter (as the SYNOPSIS shows) causes the run loop to manage I/O, one unified STDERR for
318 all Perl interpreters that ends as soon as the local interpreter process does, and the shell will
319 start killing children when the local interpreter exits.
321 It is also possible to pass in a file handle that has been opened for writing. This would be
322 useful for logging the output of the remote interpreter directly into a dedicated file.
324 =item watchdog_timeout
326 If this value is defined then it will be used as the number of seconds the watchdog will wait
327 for an update before it terminates the Perl interpreter process. The default value is undefined
328 and will not use the watchdog. See C<Object::Remote::Watchdog> for more information.
336 =item C<Object::Remote>