File Coverage

blib/lib/Object/Remote/Handle.pm
Criterion Covered Total %
statement 52 65 80.0
branch 10 12 83.3
condition 8 12 66.6
subroutine 14 23 60.8
pod 0 7 0.0
total 84 119 70.5


line stmt bran cond sub pod time code
1             package Object::Remote::Handle;
2              
3 15     15   4968 use Object::Remote::Proxy;
  15         36  
  15         405  
4 15     15   83 use Scalar::Util qw(weaken blessed);
  15         27  
  15         685  
5 15     15   89 use Object::Remote::Logging qw ( :log :dlog router );
  15         22  
  15         114  
6 15     15   5191 use Object::Remote::Future;
  15         33  
  15         896  
7 15     15   111 use Module::Runtime qw(use_module);
  15         28  
  15         103  
8 15     15   654 use Moo;
  15         29  
  15         84  
9              
10 15     15   6393 BEGIN { router()->exclude_forwarding }
11              
12             has connection => (
13             is => 'ro', required => 1, handles => ['is_valid'],
14             coerce => sub {
15             blessed($_[0])
16             ? $_[0]
17             : use_module('Object::Remote::Connection')->new_from_spec($_[0])
18             },
19             );
20              
21             has id => (is => 'rwp');
22              
23             has disarmed_free => (is => 'rwp');
24              
25 167     167 0 986 sub disarm_free { $_[0]->_set_disarmed_free(1); $_[0] }
  167         353  
26              
27             sub proxy {
28 109     109 0 1062 bless({ remote => $_[0], method => 'call' }, 'Object::Remote::Proxy');
29             }
30              
31             sub BUILD {
32 128     128 0 1627 my ($self, $args) = @_;
33 128     0   848 log_trace { "constructing remote handle" };
  0         0  
34 128 100       1417 if ($self->id) {
35 88     0   552 log_trace { "disarming free for this handle" };
  0         0  
36 88         921 $self->disarm_free;
37             } else {
38 40 50       147 die "No id supplied and no class either" unless $args->{class};
39 40   100     353 ref($_) eq 'HASH' and $_ = [ %$_ ] for $args->{args};
40 40     0   260 log_trace { "fetching id for handle and disarming free on remote side" };
  0         0  
41             $self->_set_id(
42             await_future(
43             $self->connection->send_class_call(
44             0, $args->{class},
45 40 100       244 $args->{constructor}||'new', @{$args->{args}||[]}
46             )
47             )->{remote}->disarm_free->id
48 40   50     588 );
49             }
50 127     0   1409 Dlog_trace { "finished constructing remote handle; id is $_" } $self->id;
  0         0  
51 127         1600 $self->connection->register_remote($self);
52             }
53              
54             sub call {
55 92     92 0 363 my ($self, $method, @args) = @_;
56 92         162 my $w = wantarray;
57 92         382 my $id = $self->id;
58              
59 92 100 50     359 $method = "start::${method}" if (caller(0)||'') eq 'start';
60 92     0   793 log_trace { "call('$method') has been invoked on remote handle '$id'; creating future" };
  0         0  
61              
62             future {
63 92     92   1075 log_debug { "Invoking send on connection for handle '$id' method '$method'" };
  0         0  
64 92         1029 $self->connection->send(call => $id, $w, $method, @args)
65 92         1382 };
66             }
67              
68             sub call_discard {
69 0     0 0 0 my ($self, $method, @args) = @_;
70 0     0   0 log_trace { "invoking send_discard() with 'call' for method '$method' on connection for remote handle" };
  0         0  
71 0         0 $self->connection->send_discard(call => $self->id, $method, @args);
72             }
73              
74             sub call_discard_free {
75 21     21 0 84 my ($self, $method, @args) = @_;
76 21         84 $self->disarm_free;
77 21     0   182 log_trace { "invoking send_discard() with 'call_free' for method '$method' on connection for remote handle" };
  0         0  
78 21         335 $self->connection->send_discard(call_free => $self->id, $method, @args);
79             }
80              
81             sub DEMOLISH {
82 126     126 0 35331 my ($self, $gd) = @_;
83 126     0   859 Dlog_trace { "Demolishing remote handle $_" } $self->id;
  0         0  
84 126 100 66     3180 return if $gd or $self->disarmed_free;
85             #this could happen after the connection has gone away
86 19         81 eval { $self->connection->send_free($self->id) };
  19         148  
87 19 50 66     487 if ($@ && $@ !~ m/^Attempt to invoke _send on a connection that is not valid/) {
88 0           die "Could not invoke send_free on connection for handle " . $self->id;
89             }
90             }
91              
92             1;