lib/Object/Remote/Role/Connector/PerlInterpreter.pm

   1 package Object::Remote::Role::Connector::PerlInterpreter;
   2
   3 use IPC::Open2;
   4 use IO::Handle;
   5 use Object::Remote::ModuleSender;
   6 use Object::Remote::Handle;
   7 use Object::Remote::Future;
   8 use Scalar::Util qw(blessed);
   9 use Moo::Role;
  10
  11 with 'Object::Remote::Role::Connector';
  12
  13 has module_sender => (is => 'lazy');
  14
  15 sub _build_module_sender {
  16   my ($hook) =
  17     grep {blessed($_) && $_->isa('Object::Remote::ModuleLoader::Hook') }
  18       @INC;
  19   return $hook ? $hook->sender : Object::Remote::ModuleSender->new;
  20 }
  21
  22 around connect => sub {
  23   my ($orig, $self) = (shift, shift);
  24   my $f = $self->$start::start($orig => @_);
  25   return future {
  26     $f->on_done(sub {
  27       my ($conn) = $f->get;
  28       Object::Remote::Handle->new(
  29         connection => $conn,
  30         class => 'Object::Remote::ModuleLoader',
  31         args => { module_sender => $self->module_sender }
  32       )->disarm_free;
  33       require Object::Remote::Prompt;
  34       Object::Remote::Prompt::maybe_set_prompt_command_on($conn);
  35     });
  36     $f;
  37   } 2;
  38 };
  39
  40 sub _perl_command { 'perl', '-' }
  41
  42 sub _start_perl {
  43   my $self = shift;
  44   my $pid = open2(
  45     my $foreign_stdout,
  46     my $foreign_stdin,
  47     $self->_perl_command(@_),
  48   ) or die "Failed to run perl at '$_[0]': $!";
  49   return ($foreign_stdin, $foreign_stdout, $pid);
  50 }
  51
  52 sub _open2_for {
  53   my $self = shift;
  54   my ($foreign_stdin, $foreign_stdout, $pid) = $self->_start_perl(@_);
  55   my $to_send = $self->fatnode_text;
  56   Object::Remote->current_loop
  57                 ->watch_io(
  58                     handle => $foreign_stdin,
  59                     on_write_ready => sub {
  60                       my $len = syswrite($foreign_stdin, $to_send, 4096);
  61                       if (defined $len) {
  62                         substr($to_send, 0, $len) = '';
  63                       }
  64                       # if the stdin went away, we'll never get Shere
  65                       # so it's not a big deal to simply give up on !defined
  66                       if (!defined($len) or 0 == length($to_send)) {
  67                         Object::Remote->current_loop
  68                                       ->unwatch_io(
  69                                           handle => $foreign_stdin,
  70                                           on_write_ready => 1
  71                                         );
  72                       }
  73                     }
  74                   );
  75   return ($foreign_stdin, $foreign_stdout, $pid);
  76 }
  77
  78 sub fatnode_text {
  79   my ($self) = @_;
  80   require Object::Remote::FatNode;
  81   my $text = '';
  82   $text .= 'BEGIN { $ENV{OBJECT_REMOTE_DEBUG} = 1 }'."\n"
  83     if $ENV{OBJECT_REMOTE_DEBUG};
  84   $text .= <<'END';
  85 $INC{'Object/Remote/FatNode.pm'} = __FILE__;
  86 $Object::Remote::FatNode::DATA = <<'ENDFAT';
  87 END
  88   $text .= do { no warnings 'once'; $Object::Remote::FatNode::DATA };
  89   $text .= "ENDFAT\n";
  90   $text .= <<'END';
  91 eval $Object::Remote::FatNode::DATA;
  92 END
  93   $text .= "__END__\n";
  94   return $text;
  95 }
  96
  97 1;