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 Scalar::Util qw(blessed);
   8 use Moo::Role;
   9
  10 with 'Object::Remote::Role::Connector';
  11
  12 has module_sender => (is => 'lazy');
  13
  14 sub _build_module_sender {
  15   my ($hook) =
  16     grep {blessed($_) && $_->isa('Object::Remote::ModuleLoader::Hook') }
  17       @INC;
  18   return $hook ? $hook->sender : Object::Remote::ModuleSender->new;
  19 }
  20
  21 around connect => sub {
  22   my ($orig, $self) = (shift, shift);
  23   my $conn = $self->$orig(@_);
  24   Object::Remote::Handle->new(
  25     connection => $conn,
  26     class => 'Object::Remote::ModuleLoader',
  27     args => { module_sender => $self->module_sender }
  28   )->disarm_free;
  29   return $conn;
  30 };
  31
  32 sub _perl_command { 'perl', '-' }
  33
  34 sub _start_perl {
  35   my $self = shift;
  36   my $pid = open2(
  37     my $foreign_stdout,
  38     my $foreign_stdin,
  39     $self->_perl_command(@_),
  40   ) or die "Failed to run perl at '$_[0]': $!";
  41   return ($foreign_stdin, $foreign_stdout, $pid);
  42 }
  43
  44 sub _open2_for {
  45   my $self = shift;
  46   my ($foreign_stdin, $foreign_stdout, $pid) = $self->_start_perl(@_);
  47   $foreign_stdin->autoflush(1);
  48   print $foreign_stdin 'BEGIN { $ENV{OBJECT_REMOTE_DEBUG} = 1 }'."\n"
  49     if $ENV{OBJECT_REMOTE_DEBUG};
  50   print $foreign_stdin $self->fatnode_text
  51     or die "Failed to send fatpacked data to new node on '$_[0]': $!";
  52   return ($foreign_stdin, $foreign_stdout, $pid);
  53 }
  54
  55 sub fatnode_text {
  56   my ($self) = @_;
  57   require Object::Remote::FatNode;
  58   my $text = '';
  59   $text .= 'BEGIN { $ENV{OBJECT_REMOTE_DEBUG} = 1 }'."\n"
  60     if $ENV{OBJECT_REMOTE_DEBUG};
  61   $text .= <<'END';
  62 $INC{'Object/Remote/FatNode.pm'} = __FILE__;
  63 $Object::Remote::FatNode::DATA = <<'ENDFAT';
  64 END
  65   $text .= $Object::Remote::FatNode::DATA;
  66   $text .= "ENDFAT\n";
  67   $text .= <<'END';
  68 eval $Object::Remote::FatNode::DATA;
  69 END
  70   $text .= "__END__\n";
  71   return $text;
  72 }
  73
  74 1;