Commit | Line | Data |
---|---|---|
dc28afe8 | 1 | package Object::Remote::Future; |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | use base qw(Exporter); | |
6 | ||
f4a85080 | 7 | use Object::Remote::Logging qw( :log router ); |
4e446335 | 8 | |
f4a85080 | 9 | BEGIN { router()->exclude_forwarding } |
4a9fa1a5 | 10 | |
783105c4 | 11 | use Future; |
dc28afe8 | 12 | |
3f1f1e66 | 13 | our @EXPORT = qw(future await_future await_all); |
dc28afe8 | 14 | |
fbd3b8ec | 15 | sub future (&;$) { |
783105c4 | 16 | my $f = $_[0]->(Future->new); |
fbd3b8ec | 17 | return $f if ((caller(1+($_[1]||0))||'') eq 'start'); |
dc28afe8 | 18 | await_future($f); |
19 | } | |
20 | ||
fbd3b8ec | 21 | our @await; |
22 | ||
dc28afe8 | 23 | sub await_future { |
24 | my $f = shift; | |
9d64d2d9 | 25 | log_trace { my $ir = $f->is_ready; "await_future() invoked; is_ready: $ir" }; |
dc28afe8 | 26 | return $f if $f->is_ready; |
27 | require Object::Remote; | |
28 | my $loop = Object::Remote->current_loop; | |
fbd3b8ec | 29 | { |
30 | local @await = (@await, $f); | |
31 | $f->on_ready(sub { | |
9d64d2d9 | 32 | log_trace { my $l = @await; "future has become ready, length of \@await: '$l'" }; |
33 | if ($f == $await[-1]) { | |
6b7b2732 | 34 | log_trace { "This future is not waiting on anything so calling stop on the run loop" }; |
55c0d020 | 35 | $loop->stop; |
9d64d2d9 | 36 | } |
fbd3b8ec | 37 | }); |
6b7b2732 | 38 | log_trace { "Starting run loop for newly created future" }; |
fbd3b8ec | 39 | $loop->run; |
40 | } | |
41 | if (@await and $await[-1]->is_ready) { | |
6b7b2732 | 42 | log_trace { "Last future in await list was ready, stopping run loop" }; |
fbd3b8ec | 43 | $loop->stop; |
44 | } | |
9d64d2d9 | 45 | log_trace { "await_future() returning" }; |
dc28afe8 | 46 | return wantarray ? $f->get : ($f->get)[0]; |
47 | } | |
48 | ||
3f1f1e66 | 49 | sub await_all { |
9d64d2d9 | 50 | log_trace { my $l = @_; "await_all() invoked with '$l' futures to wait on" }; |
783105c4 | 51 | await_future(Future->wait_all(@_)); |
3f1f1e66 | 52 | map $_->get, @_; |
53 | } | |
54 | ||
dc28afe8 | 55 | package start; |
56 | ||
fbd3b8ec | 57 | our $start = sub { my ($obj, $call) = (shift, shift); $obj->$call(@_); }; |
58 | ||
dc28afe8 | 59 | sub AUTOLOAD { |
60 | my $invocant = shift; | |
8ba4f2e3 | 61 | my ($method) = our $AUTOLOAD =~ /^start::(.+)$/; |
dc28afe8 | 62 | my $res; |
63 | unless (eval { $res = $invocant->$method(@_); 1 }) { | |
783105c4 | 64 | my $f = Future->new; |
dc28afe8 | 65 | $f->fail($@); |
66 | return $f; | |
67 | } | |
783105c4 | 68 | unless (Scalar::Util::blessed($res) and $res->isa('Future')) { |
69 | my $f = Future->new; | |
dc28afe8 | 70 | $f->done($res); |
71 | return $f; | |
72 | } | |
73 | return $res; | |
74 | } | |
75 | ||
fbd3b8ec | 76 | package maybe; |
77 | ||
78 | sub start { | |
79 | my ($obj, $call) = (shift, shift); | |
80 | if ((caller(1)||'') eq 'start') { | |
81 | $obj->$start::start($call => @_); | |
82 | } else { | |
83 | $obj->$call(@_); | |
84 | } | |
85 | } | |
86 | ||
9822fc76 | 87 | package maybe::start; |
88 | ||
89 | sub AUTOLOAD { | |
90 | my $invocant = shift; | |
91 | my ($method) = our $AUTOLOAD =~ /^maybe::start::(.+)$/; | |
92 | $method = "start::${method}" if ((caller(1)||'') eq 'start'); | |
93 | $invocant->$method(@_); | |
94 | } | |
95 | ||
11e7c8a5 | 96 | package then; |
97 | ||
98 | sub AUTOLOAD { | |
99 | my $invocant = shift; | |
100 | my ($method) = our $AUTOLOAD =~ /^then::(.+)$/; | |
101 | my @args = @_; | |
bc06e921 | 102 | return $invocant->then(sub { |
103 | my ($obj) = @_; | |
d002a2ea | 104 | return $obj->${\"start::${method}"}(@args); |
11e7c8a5 | 105 | }); |
11e7c8a5 | 106 | } |
107 | ||
dc28afe8 | 108 | 1; |
b9a9982d | 109 | |
110 | =head1 NAME | |
111 | ||
112 | Object::Remote::Future - Asynchronous calling for L<Object::Remote> | |
113 | ||
114 | =head1 LAME | |
115 | ||
116 | Shipping prioritised over writing this part up. Blame mst. | |
117 | ||
118 | =cut |