X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FObject-Remote.git;a=blobdiff_plain;f=lib%2FObject%2FRemote%2FRole%2FConnector%2FPerlInterpreter.pm;h=f304a8d650977fe89658d8097c151774a2027309;hp=84b298840f86e7960d2351e9182ac88fe4e3df83;hb=1b315002f7e87ede72405474f0efab1864769fac;hpb=18e789ab29dc85ae3bc1ad88df0512f07aaad0d7 diff --git a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm index 84b2988..f304a8d 100644 --- a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm +++ b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm @@ -1,6 +1,7 @@ package Object::Remote::Role::Connector::PerlInterpreter; use IPC::Open2; +use IO::Handle; use Object::Remote::ModuleSender; use Object::Remote::Handle; use Scalar::Util qw(blessed); @@ -8,34 +9,68 @@ use Moo::Role; with 'Object::Remote::Role::Connector'; -around connect => sub { - my ($orig, $self) = (shift, shift); - my $conn = $self->$orig(@_); +has module_sender => (is => 'lazy'); + +sub _build_module_sender { my ($hook) = grep {blessed($_) && $_->isa('Object::Remote::ModuleLoader::Hook') } @INC; - my $sender = $hook ? $hook->sender : Object::Remote::ModuleSender->new; + return $hook ? $hook->sender : Object::Remote::ModuleSender->new; +} + +around connect => sub { + my ($orig, $self) = (shift, shift); + my $conn = $self->$orig(@_); Object::Remote::Handle->new( connection => $conn, class => 'Object::Remote::ModuleLoader', - args => { module_sender => $sender } + args => { module_sender => $self->module_sender } )->disarm_free; + require Object::Remote::Prompt; + Object::Remote::Prompt::maybe_set_prompt_command_on($conn); return $conn; }; sub _perl_command { 'perl', '-' } -sub _open2_for { +sub _start_perl { my $self = shift; my $pid = open2( my $foreign_stdout, my $foreign_stdin, $self->_perl_command(@_), ) or die "Failed to run perl at '$_[0]': $!"; - require Object::Remote::FatNode; - print $foreign_stdin $Object::Remote::FatNode::DATA, "__END__\n" + return ($foreign_stdin, $foreign_stdout, $pid); +} + +sub _open2_for { + my $self = shift; + my ($foreign_stdin, $foreign_stdout, $pid) = $self->_start_perl(@_); + $foreign_stdin->autoflush(1); + print $foreign_stdin 'BEGIN { $ENV{OBJECT_REMOTE_DEBUG} = 1 }'."\n" + if $ENV{OBJECT_REMOTE_DEBUG}; + print $foreign_stdin $self->fatnode_text or die "Failed to send fatpacked data to new node on '$_[0]': $!"; return ($foreign_stdin, $foreign_stdout, $pid); } +sub fatnode_text { + my ($self) = @_; + require Object::Remote::FatNode; + my $text = ''; + $text .= 'BEGIN { $ENV{OBJECT_REMOTE_DEBUG} = 1 }'."\n" + if $ENV{OBJECT_REMOTE_DEBUG}; + $text .= <<'END'; +$INC{'Object/Remote/FatNode.pm'} = __FILE__; +$Object::Remote::FatNode::DATA = <<'ENDFAT'; +END + $text .= $Object::Remote::FatNode::DATA; + $text .= "ENDFAT\n"; + $text .= <<'END'; +eval $Object::Remote::FatNode::DATA; +END + $text .= "__END__\n"; + return $text; +} + 1;