File Coverage

blib/lib/Mojo/AsyncAwait/Backend/Coro.pm
Criterion Covered Total %
statement 81 83 97.5
branch 22 26 84.6
condition 1 3 33.3
subroutine 17 17 100.0
pod 2 2 100.0
total 123 131 93.8


line stmt bran cond sub pod time code
1             package Mojo::AsyncAwait::Backend::Coro;
2 9     9   5030 use Mojo::Base -strict;
  9         36  
  9         60  
3              
4 9     9   1082 use Carp ();
  9         20  
  9         155  
5 9     9   4698 use Coro::State ();
  9         50705  
  9         211  
6 9     9   63 use Mojo::Util;
  9         36  
  9         312  
7 9     9   513 use Mojo::Promise;
  9         115840  
  9         98  
8 9     9   257 use Sub::Util ();
  9         21  
  9         157  
9              
10 9     9   44 use Exporter 'import';
  9         18  
  9         4614  
11              
12             our @EXPORT = (qw/async await/);
13              
14             my $main = Coro::State->new;
15             $main->{desc} = 'Mojo::AsyncAwait::Backend::Coro/$main';
16              
17             # LIFO stack of coroutines waiting to come back to
18             # always has $main as the bottom of the stack
19             my @stack = ($main);
20              
21             # Coroutines that are ostensible done but need someone to kill them
22             my @clean;
23              
24             # _push adds a coroutine to the stack and enters it
25             # when control returns to the original pusher, it will clean up
26             # any coroutines that are waiting to be cleaned up
27              
28             sub _push {
29 22     22   66 push @stack, @_;
30 22         1011 $stack[-2]->transfer($stack[-1]);
31 22         316 $_->cancel for @clean;
32 22         73 @clean = ();
33             }
34              
35             # _pop pops the current coroutine off the stack. If given a callback, it calls
36             # a callback on it, otherwise, schedules it for cleanup. It then transfers to
37             # the next one on the stack. Note that it can't pop-and-return (which would
38             # make more sense) because any action on it must happen before control is
39             # transfered away from it
40              
41             sub _pop (;&) {
42 22 50   22   119 Carp::croak "Cannot leave the main thread"
43             if $stack[-1] == $main;
44 22         66 my ($cb) = @_;
45 22         52 my $current = pop @stack;
46 22 100       71 if ($cb) { $cb->($current) }
  11         34  
47 11         30 else { push @clean, $current }
48 22         1117 $current->transfer($stack[-1]);
49             }
50              
51             sub async {
52 11     11 1 17532 my $body = pop;
53 11         49 my $opts = _parse_opts(@_);
54 11         49 my @caller = caller;
55              
56 11         36 my $subname = "$caller[0]::__ASYNCSUB__";
57 11         31 my $bodyname = "$caller[0]::__ASYNCBODY__";
58 11 100       48 if (defined(my $name = $opts->{-name})) {
59 3 100       57 $subname = $opts->{-install} ? "$caller[0]::$name" : "$subname($name)";
60 3         13 $bodyname .= "($name)";
61             }
62 11         43 my $desc = "declared at $caller[1] line $caller[2]";
63              
64 11 50       288 Sub::Util::set_subname($bodyname => $body)
65             if Sub::Util::subname($body) =~ /::__ANON__$/;
66              
67             my $wrapped = sub {
68 11     11   34979 my @caller = caller;
        3      
69 11         95 my $promise = Mojo::Promise->new;
70             my $coro = Coro::State->new(sub {
71 11 100       46 eval {
72 9     9   2305 BEGIN { $^H{'Mojo::AsyncAwait::Backend::Coro/async'} = 1 }
73 11         46 $promise->resolve($body->(@_)); 1
  10         3564  
74             } or $promise->reject($@);
75 11         152 _pop;
76 11         941 }, @_);
77 11         108 $coro->{desc} = "$subname called at $caller[1] line $caller[2], $desc";
78 11         53 _push $coro;
79 11         67 return $promise;
80 11         66 };
81              
82 11 100       53 if ($opts->{-install}) {
83 2         14 Mojo::Util::monkey_patch $caller[0], $opts->{-name} => $wrapped;
84 2         52 return;
85             }
86              
87 9         55 Sub::Util::set_subname $subname => $wrapped;
88 9         42 return $wrapped;
89             }
90              
91             # this prototype prevents the perl tokenizer from seeing await as an
92             # indirect method
93              
94             sub await (*) {
95             {
96             # check that our caller is actually an async function
97 9     9 1 71 no warnings 'uninitialized';
  9     13   21  
  9         3893  
  13         6240  
98 13         29 my $level = 1;
99 13         186 my ($caller, $hints) = (caller($level))[3, 10];
100              
101             # being inside of an eval is ok too
102 13         93 ($caller, $hints) = (caller(++$level))[3, 10] while $caller eq '(eval)';
103              
104             Carp::croak 'await may only be called from in async function'
105 13 100       367 unless $hints->{'Mojo::AsyncAwait::Backend::Coro/async'};
106             }
107              
108 11         67 my $promise = Mojo::Promise->resolve($_[0]);
109              
110 11         1476 my (@retvals, $err);
111             _pop {
112 11     11   30 my $current = shift;
113             $promise->then(
114             sub {
115 11         2931742 @retvals = @_;
116 11         53 _push $current;
117             },
118             sub {
119 0         0 $err = shift;
120 0         0 _push $current;
121             }
122 11         143 );
123 11         91 };
124              
125             # "_push $current" in the above callback brings us here
126 11 50       92 Carp::croak($err) if $err;
127 11 100       101 return wantarray ? @retvals : $retvals[0];
128             }
129              
130             sub _parse_opts {
131 11 100   11   50 return {} unless @_;
132             return {
133 3 100       19 -name => shift,
134             -install => 1,
135             } if @_ == 1;
136              
137 1         5 my %opts = @_;
138             Carp::croak 'Cannot install a sub without a name'
139 1 50 33     7 if $opts{-install} && !defined $opts{-name};
140              
141 1         4 return \%opts;
142             }
143              
144             1;
145              
146             =encoding utf8
147              
148             =head1 NAME
149              
150             Mojo::AsyncAwait::Backend::Coro - An Async/Await implementation for Mojolicious using Coro
151              
152             =head1 SYNOPSIS
153              
154             use Mojolicious::Lite -signatures;
155             use Mojo::AsyncAwait;
156              
157             get '/' => async sub ($c) {
158              
159             my $mojo = await $c->ua->get_p('https://mojolicious.org');
160             my $cpan = await $c->ua->get_p('https://metacpan.org');
161              
162             $c->render(json => {
163             mojo => $mojo->result->code,
164             cpan => $cpan->result->code
165             });
166             };
167              
168             app->start;
169              
170             =head1 DESCRIPTION
171              
172             As the name suggests, L is an implementation
173             of the Async/Await pattern, using L and L. See more at
174             L.
175              
176             =head1 CAVEATS
177              
178             This implementation relies on L which does some very magical things to
179             the Perl interpreter. All caveats that apply to using L apply to
180             this module as well.
181              
182             Also note that while a L-based implementation need not rely on L
183             being called directly from an L function, it is currently prohibitied
184             because it is likely that other/future implementations will rely on that
185             behavior and thus it should not be relied upon.
186              
187             =head1 KEYWORDS
188              
189             L provides two keywords (i.e. functions), both
190             exported by default. They are re-exported by L if it is the
191             chosen implementation.
192              
193             =head2 async
194              
195             my $sub = async sub { ... };
196              
197             The async keyword wraps a subroutine as an asynchronous subroutine which is
198             able to be suspended via L. The return value(s) of the subroutine, when
199             called, will be wrapped in a L.
200              
201             The async keyword must be called with a subroutine reference, which will be the
202             body of the async subroutine.
203              
204             Note that the returned subroutine reference is not invoked for you.
205             If you want to immediately invoke it, you need to so manually.
206              
207             my $promise = async(sub{ ... })->();
208              
209             If called with a preceding name, the subroutine will be installed into the current package with that name.
210              
211             async installed_sub => sub { ... };
212             installed_sub();
213              
214             If called with key-value arguments starting with a dash, the following options are available.
215              
216             =over
217              
218             =item -install
219              
220             If set to a true value, the subroutine will be installed into the current package.
221             Default is false.
222             Setting this value to true without a C<-name> is an error.
223              
224             =item -name
225              
226             If C<-install> is false, this is a diagnostic name to be included in the subname for debugging purposes.
227             This name is seen in diagnostic information, like stack traces.
228              
229             my $named_sub = async -name => my_name => sub { ... };
230             $named_sub->();
231              
232             Otherwise this is the name that will be installed into the current package.
233              
234             =back
235              
236             Therefore, passing a bare name as is identical to setting both C<-name> and C<< -install => 1 >>.
237              
238             async -name => installed_sub, -install => 1 => sub { ... };
239             installed_sub();
240              
241             If the subroutine is installed, whether by passing a bare name or the C<-install> option, nothing is returned.
242             Otherwise the return value is the wrapped async subroutine reference.
243              
244             =head2 await
245              
246             my $tx = await Mojo::UserAgent->new->get_p('https://mojolicious.org');
247             my @results = await (async sub { ...; return @async_results })->();
248              
249             The await keyword suspends execution of an async sub until a promise is
250             fulfilled, returning the promise's results. In list context all promise results
251             are returned. For ease of use, in scalar context the first promise result is
252             returned and the remainder are discarded.
253              
254             If the value passed to await is not a promise (defined as having a C
255             method), it will be wrapped in a Mojo::Promise for consistency. This is mostly
256             inconsequential to the user.
257              
258             Note that await can only take one promise as an argument. If you wanted to
259             await multiple promises you probably want L or less likely
260             L.
261              
262             my $results = await Mojo::Promise->all(@promises);
263              
264             =head1 SEE ALSO
265              
266             L, L, L, L
267              
268             =cut