From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sun, 30 Oct 2011 06:10:16 +0000 (+0000)
Subject: object proxying system
X-Git-Tag: v0.001001~30
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FTak.git;a=commitdiff_plain;h=e49c818e503d04af3b615cbeb7e0d9e40697f4ac;hp=6fd3956225d96b0d2ce19655ebd671917cdd0d0e

object proxying system
---

diff --git a/lib/Tak/ObjectClient.pm b/lib/Tak/ObjectClient.pm
new file mode 100644
index 0000000..2761cc6
--- /dev/null
+++ b/lib/Tak/ObjectClient.pm
@@ -0,0 +1,63 @@
+package Tak::ObjectClient;
+
+use Tak::ObjectProxy;
+use Moo;
+
+with 'Tak::Role::ObjectMangling';
+
+has world => (is => 'ro', required => 1);
+
+has remote => (is => 'lazy');
+
+sub _build_remote {
+  my ($self) = @_;
+  my $world = $self->world;
+  $world->remote_for('meta')->blocking_request(
+    register => object_service => 'Tak::ObjectService'
+  );
+  $world->remote_for('object_service')
+}
+
+sub proxy_method_call {
+  my ($self, @call) = @_;
+  my $ready = $self->encode_objects(\@call);
+  my $context = wantarray;
+  my @res = $self->remote->blocking_request(call_method => $context => $ready);
+  if ($res[0] eq 'RESULT') {
+    my $unpacked = $self->decode_objects($res[1]);
+    if ($context) {
+      return @$unpacked;
+    } elsif (defined $context) {
+      return $unpacked->[0];
+    } else {
+      return;
+    }
+  } else {
+    die $res[1];
+  }
+}
+
+sub proxy_death {
+  my ($self, $proxy) = @_;
+  $self->remote->blocking_request(remove_object => $proxy->{tag});
+}
+
+sub inflate {
+  my ($self, $tag) = @_;
+  bless({ client => $self, tag => $tag }, 'Tak::ObjectProxy');
+}
+
+sub deflate {
+  my ($self, $obj) = @_;
+  unless (ref($obj) eq 'Tak::ObjectProxy') {
+    die "Can't deflate non-proxied object ${obj}";
+  }
+  return +{ __proxied_object__ => $obj->{tag} };
+}
+
+sub new_object {
+  my ($self, $class, @args) = @_;
+  $self->proxy_method_call($class, 'new', @args);
+}
+
+1;
diff --git a/lib/Tak/ObjectProxy.pm b/lib/Tak/ObjectProxy.pm
new file mode 100644
index 0000000..827e0bd
--- /dev/null
+++ b/lib/Tak/ObjectProxy.pm
@@ -0,0 +1,16 @@
+package Tak::ObjectProxy;
+
+use strictures 1;
+
+sub AUTOLOAD {
+  my $self = shift;
+  (my $method) = (our $AUTOLOAD =~ /([^:]+)$/);
+  $self->{client}->proxy_method_call($self, $method => @_);
+}
+
+sub DESTROY {
+  my $self = shift;
+  $self->{client}->proxy_death($self);
+}
+
+1;
diff --git a/lib/Tak/ObjectService.pm b/lib/Tak/ObjectService.pm
new file mode 100644
index 0000000..94f1248
--- /dev/null
+++ b/lib/Tak/ObjectService.pm
@@ -0,0 +1,49 @@
+package Tak::ObjectService;
+
+use overload ();
+use Moo;
+
+with 'Tak::Role::ObjectMangling';
+
+has proxied => (is => 'ro', init_arg => undef, default => sub { {} });
+
+sub inflate {
+  my ($self, $tag) = @_;
+  $self->proxied->{$tag};
+}
+
+sub deflate {
+  my ($self, $obj) = @_;
+  my $tag = overload::StrVal($obj);
+  $self->proxied->{$tag} = $obj;
+  return +{ __proxied_object__ => $tag };
+}
+
+sub handle_call_method {
+  my ($self, $context, $call) = @_;
+  my ($invocant, $method, @args) = @{$self->decode_objects($call)};
+  my @res;
+  eval {
+    if (!ref($invocant)) {
+      (my $file = $invocant) =~ s/::/\//g;
+      require "${file}.pm";
+    }
+    if ($context) {
+      @res = $invocant->$method(@args);
+    } elsif (defined $context) {
+      $res[0] = $invocant->$method(@args);
+    } else {
+      $invocant->$method(@args);
+    }
+    1;
+  } or return FAILURE => "$@";
+  return RESULT => $self->encode_objects(\@res);
+}
+
+sub handle_remove_object {
+  my ($self, $tag) = @_;
+  my $had = !!delete $self->proxied->{$tag};
+  return RESULT => $had;
+}
+
+1;