From: Matt S Trout Date: Fri, 20 Jul 2012 19:15:34 +0000 (+0000) Subject: parameterize more of the connector information X-Git-Tag: v0.002002~4 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=498c4ad5b1cc2db13c7b581b44ff3f6b9e33eaba;p=scpubgit%2FObject-Remote.git parameterize more of the connector information --- diff --git a/lib/Object/Remote/Connector/LocalSudo.pm b/lib/Object/Remote/Connector/LocalSudo.pm index 304b3e9..043b688 100644 --- a/lib/Object/Remote/Connector/LocalSudo.pm +++ b/lib/Object/Remote/Connector/LocalSudo.pm @@ -20,13 +20,15 @@ sub _build_password_callback { } } -sub _sudo_perl_command { +has sudo_perl_command => (is => 'lazy'); + +sub _build_sudo_perl_command { my ($self) = @_; return 'sudo', '-S', '-u', $self->target_user, '-p', "[sudo] password please\n", 'perl', '-MPOSIX=dup2', '-e', 'print STDERR "GO\n"; exec(@ARGV);', - $self->_perl_command($self->target_user); + $self->perl_command; } sub _start_perl { @@ -36,7 +38,7 @@ sub _start_perl { my $foreign_stdin, my $foreign_stdout, $sudo_stderr, - $self->_sudo_perl_command(@_) + @{$self->sudo_perl_command} ) or die "open3 failed: $!"; chomp(my $line = <$sudo_stderr>); if ($line eq "GO") { diff --git a/lib/Object/Remote/Connector/SSH.pm b/lib/Object/Remote/Connector/SSH.pm index fb6ed4b..4a07762 100644 --- a/lib/Object/Remote/Connector/SSH.pm +++ b/lib/Object/Remote/Connector/SSH.pm @@ -8,10 +8,14 @@ with 'Object::Remote::Role::Connector::PerlInterpreter'; has ssh_to => (is => 'ro', required => 1); -around _perl_command => sub { - my ($orig, $self) = @_; - return 'ssh', '-A', $self->ssh_to, $self->$orig; -}; +has ssh_perl_command => (is => 'lazy'); + +sub _build_ssh_perl_command { + my ($self) = @_; + return [ 'ssh', '-A', $self->ssh_to, @{$self->perl_command} ]; +} + +sub final_perl_command { shift->ssh_perl_command } no warnings 'once'; diff --git a/lib/Object/Remote/MiniLoop.pm b/lib/Object/Remote/MiniLoop.pm index e7be944..3951bf9 100644 --- a/lib/Object/Remote/MiniLoop.pm +++ b/lib/Object/Remote/MiniLoop.pm @@ -43,6 +43,7 @@ sub watch_io { $self->_write_select->add($fh); $self->_write_watches->{$fh} = $cb; } + return; } sub unwatch_io { diff --git a/lib/Object/Remote/Role/Connector.pm b/lib/Object/Remote/Role/Connector.pm index cc8684b..2f89d27 100644 --- a/lib/Object/Remote/Role/Connector.pm +++ b/lib/Object/Remote/Role/Connector.pm @@ -6,6 +6,8 @@ use Moo::Role; requires '_open2_for'; +has timeout => (is => 'ro', default => sub { { after => 5 } }); + sub connect { my $self = shift; my ($send_to_fh, $receive_from_fh, $child_pid) = $self->_open2_for(@_); @@ -34,7 +36,7 @@ sub connect { }); Object::Remote->current_loop ->watch_time( - after => 5, + %{$self->timeout}, code => sub { $f->fail("Connection timed out") unless $f->is_ready; undef($channel); diff --git a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm index 23ff0ea..cfa039a 100644 --- a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm +++ b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm @@ -19,6 +19,10 @@ sub _build_module_sender { return $hook ? $hook->sender : Object::Remote::ModuleSender->new; } +has perl_command => (is => 'lazy'); + +sub _build_perl_command { [ 'perl', '-' ] } + around connect => sub { my ($orig, $self) = (shift, shift); my $f = $self->$start::start($orig => @_); @@ -37,14 +41,14 @@ around connect => sub { } 2; }; -sub _perl_command { 'perl', '-' } +sub final_perl_command { shift->perl_command } sub _start_perl { my $self = shift; my $pid = open2( my $foreign_stdout, my $foreign_stdin, - $self->_perl_command(@_), + @{$self->final_perl_command}, ) or die "Failed to run perl at '$_[0]': $!"; return ($foreign_stdin, $foreign_stdout, $pid); }