Commit | Line | Data |
9e72f0cf |
1 | package Object::Remote; |
2 | |
3 | use Object::Remote::MiniLoop; |
4 | use Object::Remote::Proxy; |
84b04178 |
5 | use Scalar::Util qw(weaken blessed); |
dc28afe8 |
6 | use Object::Remote::Future; |
84b04178 |
7 | use Module::Runtime qw(use_module); |
9e72f0cf |
8 | use Moo; |
9 | |
84b04178 |
10 | sub new::on { |
11 | my ($class, $on, @args) = @_; |
12 | __PACKAGE__->new( |
13 | connection => $on, |
14 | class => $class, |
15 | args => \@args |
16 | )->proxy; |
17 | } |
18 | |
19 | has connection => ( |
20 | is => 'ro', required => 1, |
21 | coerce => sub { |
22 | blessed($_[0]) |
23 | ? $_[0] |
24 | : use_module('Object::Remote::Connection')->new_from_spec($_[0]) |
25 | }, |
26 | ); |
9e72f0cf |
27 | |
28 | has id => (is => 'rwp'); |
29 | |
ad4f54b2 |
30 | has disarmed_free => (is => 'rwp'); |
31 | |
32 | sub disarm_free { $_[0]->_set_disarmed_free(1); $_[0] } |
33 | |
2065b08b |
34 | sub proxy { |
35 | bless({ remote => $_[0], method => 'call' }, 'Object::Remote::Proxy'); |
9e72f0cf |
36 | } |
37 | |
38 | sub BUILD { |
39 | my ($self, $args) = @_; |
40 | unless ($self->id) { |
41 | die "No id supplied and no class either" unless $args->{class}; |
542d5b5c |
42 | ref($_) eq 'HASH' and $_ = [ %$_ ] for $args->{args}; |
9e72f0cf |
43 | $self->_set_id( |
dc28afe8 |
44 | await_future( |
9e72f0cf |
45 | $self->connection->send( |
84b04178 |
46 | class_call => $args->{class}, 0, |
9e72f0cf |
47 | $args->{constructor}||'new', @{$args->{args}||[]} |
48 | ) |
ad4f54b2 |
49 | )->{remote}->disarm_free->id |
9e72f0cf |
50 | ); |
51 | } |
52 | $self->connection->register_remote($self); |
53 | } |
54 | |
55 | sub current_loop { |
56 | our $Current_Loop ||= Object::Remote::MiniLoop->new |
57 | } |
58 | |
59 | sub call { |
9d804009 |
60 | my ($self, $method, @args) = @_; |
dc28afe8 |
61 | my $w = wantarray; |
3f1f1e66 |
62 | $method = "start::${method}" if (caller(0)||'') eq 'start'; |
dc28afe8 |
63 | future { |
64 | $self->connection->send(call => $self->id, $w, $method, @args) |
65 | }; |
9e72f0cf |
66 | } |
67 | |
2065b08b |
68 | sub call_discard { |
69 | my ($self, $method, @args) = @_; |
70 | $self->connection->send_discard(call => $self->id, $method, @args); |
71 | } |
72 | |
8131a88a |
73 | sub call_discard_free { |
74 | my ($self, $method, @args) = @_; |
75 | $self->disarm_free; |
76 | $self->connection->send_discard(call_free => $self->id, $method, @args); |
77 | } |
78 | |
9e72f0cf |
79 | sub DEMOLISH { |
80 | my ($self, $gd) = @_; |
ad4f54b2 |
81 | return if $gd or $self->disarmed_free; |
9e72f0cf |
82 | $self->connection->send_free($self->id); |
83 | } |
84 | |
85 | 1; |