From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sun, 30 Oct 2011 03:17:33 +0000 (+0000)
Subject: create world object, repl script
X-Git-Tag: v0.001001~33
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8b6c1f59e563ab0ccdd728c327b2c994833fcd87;hp=ca30c15e4b434c7ba6dbe61ed2df9125806d93ab;p=scpubgit%2FTak.git

create world object, repl script
---

diff --git a/bin/tak-repl b/bin/tak-repl
new file mode 100644
index 0000000..7bc5d3e
--- /dev/null
+++ b/bin/tak-repl
@@ -0,0 +1,15 @@
+#!/usr/bin/env perl
+
+use Tak::WorldHandle;
+use Tak::REPL;
+use strictures 1;
+
+my $world = do {
+  if (my $ssh_target = $ARGV[0]) {
+    Tak::WorldHandle->new_remote($ssh_target);
+  } else {
+    Tak::WorldHandle->new_local;
+  }
+};
+
+Tak::REPL->new(world => $world)->run;
diff --git a/lib/Tak/REPL.pm b/lib/Tak/REPL.pm
new file mode 100644
index 0000000..1191c72
--- /dev/null
+++ b/lib/Tak/REPL.pm
@@ -0,0 +1,35 @@
+package Tak::REPL;
+
+use Term::ReadLine;
+use Moo;
+
+has world => (is => 'ro', required => 1);
+
+has remote => (is => 'lazy');
+
+sub _build_remote { shift->world->remote_for('EVAL') }
+
+sub run {
+  my $remote = $_[0]->remote;
+  my $read = Term::ReadLine->new('REPL');
+
+  while (1) {
+    my $line = $read->readline('re.pl$ ');
+    last unless defined $line;
+    next unless length $line;
+    my @reply = $remote->blocking_request(eval => $line);
+    if ($reply[0] eq 'MISTAKE') {
+      die "Botch: ".join(': ', @reply[1,2]);
+    }
+    my $ret = $reply[1];
+    print $ret->{return};
+    if ($ret->{stdout}) {
+      chomp($ret->{stdout});
+      print "STDOUT:\n${\$ret->{stdout}}\n";
+    }
+    if ($ret->{stderr}) {
+      chomp($ret->{stderr});
+      print "STDERR:\n${\$ret->{stderr}}\n";
+    }
+  }
+}
diff --git a/lib/Tak/Router.pm b/lib/Tak/Router.pm
index d48f28b..58b73bf 100644
--- a/lib/Tak/Router.pm
+++ b/lib/Tak/Router.pm
@@ -1,6 +1,7 @@
 package Tak::Router;
 
 use Tak::Request;
+use Tak::ServiceManager;
 use Moo;
 
 has channel => (is => 'ro', required => 1);
@@ -96,4 +97,11 @@ sub receive_response {
   $request->respond(@result);
 }
 
+sub register {
+  my ($self, $name, $service) = @_;
+  $self->local_request_handlers->{$name} = Tak::ServiceManager->new(
+    service => $service
+  );
+}
+
 1;
diff --git a/lib/Tak/World.pm b/lib/Tak/World.pm
new file mode 100644
index 0000000..49db7ca
--- /dev/null
+++ b/lib/Tak/World.pm
@@ -0,0 +1,48 @@
+package Tak::World;
+
+use Tak::JSONChannel;
+use Tak::ServiceManager;
+use Tak::EvalService;
+use Tak::ModuleLoader;
+use Tak::Router;
+use Tak::Remote;
+
+use Moo;
+
+has channel_args => (is => 'ro', required => 1);
+
+sub new_from_stdio {
+  open my $stdin, '<&', \*STDIN;
+  open my $stdout, '>&', \*STDOUT;
+  shift->new(channel_args => { read_fh => $stdin, write_fh => $stdout });
+}
+
+has router => (is => 'lazy');
+
+sub _build_router {
+  my ($self) = @_;
+  my $channel = Tak::JSONChannel->new($self->channel_args);
+
+  my $router = Tak::Router->new(
+    channel => $channel
+  );
+  
+  $router->register(EVAL => Tak::EvalService->new);
+  
+  my $remote = Tak::Remote->new(
+    router => $router,
+    name => 'MODULE_SENDER'
+  );
+  
+  my $loader = Tak::ModuleLoader->new(
+    remote => $remote
+  );
+  
+  unshift @INC, $loader->inc_callback;
+  
+  return $router;
+}
+
+sub run { shift->router->run }
+  
+1;
diff --git a/lib/Tak/WorldHandle.pm b/lib/Tak/WorldHandle.pm
new file mode 100644
index 0000000..8549cc2
--- /dev/null
+++ b/lib/Tak/WorldHandle.pm
@@ -0,0 +1,59 @@
+package Tak::WorldHandle;
+
+use IPC::Open2 ();
+use Tak::Router;
+use Tak::JSONChannel;
+use Tak::ModuleSender;
+use Tak::Remote;
+use IO::All;
+use Moo;
+
+sub Tak::WorldHandle::_local::open2 {
+  shift;
+  my $pid = IPC::Open2::open2(my $out, my $in, @_)
+    or die "Couldn't open2 child: $!";
+  return ($in, $out, $pid);
+}
+
+has connection => (is => 'ro', required => 1);
+
+sub new_local {
+  shift->new(connection => bless({}, 'Tak::WorldHandle::_local'))
+}
+
+sub new_remote {
+  my ($class, $target) = @_;
+  $class->new(connection => do {
+    require Net::OpenSSH;
+    Net::OpenSSH->new($target);
+  });
+}
+
+has router => (is => 'lazy');
+
+sub _build_router {
+  my ($self) = @_;
+
+  my ($stdin, $stdout) = $self->connection->open2('perl -');
+
+  $stdin->print(io('takd')->all, "__END__\n");
+
+  my $channel = Tak::JSONChannel->new(
+    read_fh => $stdout, write_fh => $stdin
+  );
+
+  my $router = Tak::Router->new(
+    channel => $channel
+  );
+
+  $router->register(MODULE_SENDER => Tak::ModuleSender->new);
+
+  return $router;
+}
+
+sub remote_for {
+  my ($self, $name) = @_;
+  Tak::Remote->new(router => $self->router, name => $name);
+}
+
+1;