From: Matt S Trout 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?a=commitdiff_plain;h=e49c818e503d04af3b615cbeb7e0d9e40697f4ac;p=scpubgit%2FTak.git 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;