refactored fatpacking and added LocalSudo connector
Robert 'phaylon' Sedlacek [Tue, 29 May 2012 23:32:16 +0000 (23:32 +0000)]
lib/Object/Remote/Connection.pm
lib/Object/Remote/Connector/Local.pm
lib/Object/Remote/Connector/LocalSudo.pm [new file with mode: 0644]
lib/Object/Remote/Connector/SSH.pm
lib/Object/Remote/Role/Connector/PerlInterpreter.pm [new file with mode: 0644]

index d45556d..18fea05 100644 (file)
@@ -75,6 +75,7 @@ sub _build__json {
 BEGIN {
   unshift our @Guess, sub { blessed($_[0]) ? $_[0] : undef };
   eval { require Object::Remote::Connector::Local };
+  eval { require Object::Remote::Connector::LocalSudo };
   eval { require Object::Remote::Connector::SSH };
 }
 
index 2064ac6..ce96d9a 100644 (file)
@@ -1,20 +1,8 @@
 package Object::Remote::Connector::Local;
 
-use IPC::Open2;
 use Moo;
 
-with 'Object::Remote::Role::Connector';
-
-sub _open2_for {
-  my $open_this = (
-    -d 't' && -e 'bin/object-remote-node'
-      ? 'bin/object-remote-node'
-      : 'object-remote-node'
-  );
-  my $pid = open2(my $its_stdout, my $its_stdin, 'bin/object-remote-node')
-    or die "Couldn't start local node: $!";
-  return ($its_stdin, $its_stdout, $pid);
-}
+with 'Object::Remote::Role::Connector::PerlInterpreter';
 
 push @Object::Remote::Connection::Guess, sub {
   if (($_[0]||'') eq '-') { __PACKAGE__->new->connect }
diff --git a/lib/Object/Remote/Connector/LocalSudo.pm b/lib/Object/Remote/Connector/LocalSudo.pm
new file mode 100644 (file)
index 0000000..c23f2e9
--- /dev/null
@@ -0,0 +1,22 @@
+package Object::Remote::Connector::LocalSudo;
+
+use Moo;
+
+extends 'Object::Remote::Connector::Local';
+
+around _perl_command => sub {
+  my ($orig, $self, $target_user) = @_;
+  return 'sudo', '-u', $target_user, $self->$orig($target_user);
+};
+
+push @Object::Remote::Connection::Guess, sub {
+  for ($_[0]) {
+    # username followed by @
+    if (defined and !ref and /^ ([^\@]*?) \@ $/x) {
+      return __PACKAGE__->new->connect($1);
+    }
+  }
+  return;
+};
+
+1;
index 7d6142c..0821c96 100644 (file)
@@ -1,30 +1,14 @@
 package Object::Remote::Connector::SSH;
 
-use Object::Remote::FatNode;
 use Object::Remote::ModuleSender;
 use Object::Remote::Handle;
-use IPC::Open2;
 use Moo;
 
-with 'Object::Remote::Role::Connector';
+with 'Object::Remote::Role::Connector::PerlInterpreter';
 
-sub _open2_for {
-  my $self = shift;
-  my $pid = open2(my $ssh_stdout, my $ssh_stdin, 'ssh', $_[0], 'perl', '-')
-    or die "Failed to start ssh connection: $!";;
-  print $ssh_stdin $Object::Remote::FatNode::DATA, "__END__\n";
-  return ($ssh_stdin, $ssh_stdout, $pid);
-}
-
-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 => Object::Remote::ModuleSender->new }
-  )->disarm_free;
-  return $conn;
+around _perl_command => sub {
+  my ($orig, $self, $target) = @_;
+  return 'ssh', $target, $self->$orig($target);
 };
 
 sub _ssh_object_for {
@@ -35,7 +19,7 @@ sub _ssh_object_for {
 push @Object::Remote::Connection::Guess, sub { 
   for ($_[0]) {
     # 0-9 a-z _ - first char, those or . subsequent - hostnamish
-    if (defined and !ref and /^(?:.*?\@)?[\w\-][\w\-\.]*/) {
+    if (defined and !ref and /^(?:.*?\@)?[\w\-][\w\-\.]/) {
       return __PACKAGE__->new->connect($_[0]);
     }
   }
diff --git a/lib/Object/Remote/Role/Connector/PerlInterpreter.pm b/lib/Object/Remote/Role/Connector/PerlInterpreter.pm
new file mode 100644 (file)
index 0000000..17945d3
--- /dev/null
@@ -0,0 +1,35 @@
+package Object::Remote::Role::Connector::PerlInterpreter;
+
+use IPC::Open2;
+use Object::Remote::ModuleSender;
+use Object::Remote::Handle;
+use Object::Remote::FatNode;
+use Moo::Role;
+
+with 'Object::Remote::Role::Connector';
+
+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 => Object::Remote::ModuleSender->new }
+  )->disarm_free;
+  return $conn;
+};
+
+sub _perl_command { 'perl', '-' }
+
+sub _open2_for {
+  my $self = shift;
+  my $pid = open2(
+    my $foreign_stdout,
+    my $foreign_stdin,
+    $self->_perl_command(@_),
+  ) or die "Failed to run perl at '$_[0]': $!";
+  print $foreign_stdin $Object::Remote::FatNode::DATA, "__END__\n";
+  return ($foreign_stdin, $foreign_stdout, $pid);
+}
+
+1;