File Coverage

blib/lib/Mojo/Promise.pm
Criterion Covered Total %
statement 151 185 81.6
branch 46 60 76.6
condition 26 42 61.9
subroutine 45 63 71.4
pod 15 27 55.5
total 283 377 75.0


line stmt bran cond sub pod time code
1             package Mojo::Promise;
2 63     67   963 use Mojo::Base -base;
  63         172  
  63         570  
3              
4 63     63   475 use Carp qw(carp croak);
  63         177  
  63         3736  
5 63     63   21234 use Mojo::Exception;
  63         188  
  63         2690  
6 63     63   941 use Mojo::IOLoop;
  63         143  
  63         449  
7 63     63   352 use Scalar::Util qw(blessed);
  63         151  
  63         3676  
8              
9 63   50 63   384 use constant DEBUG => $ENV{MOJO_PROMISE_DEBUG} || 0;
  63         145  
  63         233004  
10              
11             has ioloop => sub { Mojo::IOLoop->singleton }, weak => 1;
12              
13       0 0   sub AWAIT_CHAIN_CANCEL { }
14 0     0 0 0 sub AWAIT_CLONE { _await('clone', @_) }
15 0     0 0 0 sub AWAIT_DONE { _settle_await(resolve => @_) }
16 0     0 0 0 sub AWAIT_FAIL { _settle_await(reject => @_) }
17              
18             sub AWAIT_GET {
19 0     0 0 0 my $self = shift;
20 0   0     0 my @results = @{$self->{results} // []};
  0         0  
21 0 0       0 return wantarray ? @results : $results[0] if $self->{status} eq 'resolve';
    0          
22 0 0 0     0 die $results[0] if ref $results[0] || $results[0] =~ m!\n!;
23 0         0 croak $results[0];
24             }
25              
26 0     0 0 0 sub AWAIT_IS_CANCELLED {undef}
27              
28             sub AWAIT_IS_READY {
29 0     0 0 0 my $self = shift;
30 0         0 $self->{handled} = 1;
31 0   0     0 return !!$self->{results} && !@{$self->{resolve}} && !@{$self->{reject}};
32             }
33              
34 0     0 0 0 sub AWAIT_NEW_DONE { _await('resolve', @_) }
35 0     0 0 0 sub AWAIT_NEW_FAIL { _await('reject', @_) }
36              
37       0 0   sub AWAIT_ON_CANCEL { }
38              
39             sub AWAIT_ON_READY {
40 0     0 0 0 shift->_finally(0, @_)->catch(sub { });
        0      
41             }
42              
43             sub AWAIT_WAIT {
44 0     0 0 0 my $self = shift;
45 0     0   0 $self->catch(sub { })->wait;
46 0         0 return $self->AWAIT_GET;
47             }
48              
49             sub DESTROY {
50 784     784   30225 my $self = shift;
51 784 100 100     7909 return if $self->{handled} || ($self->{status} // '') ne 'reject' || !$self->{results};
      100        
      66        
52 7         14 carp "Unhandled rejected promise: @{$self->{results}}";
  7         1135  
53 7         238 warn $self->{debug}->message("-- Destroyed promise\n")->verbose(1)->to_string if DEBUG;
54             }
55              
56 11     11 1 133 sub all { _all(2, @_) }
57 2     2 1 15 sub all_settled { _all(0, @_) }
58 2     2 1 18 sub any { _all(3, @_) }
59              
60 177     177 1 1148 sub catch { shift->then(undef, shift) }
61              
62 617     617 1 1320 sub clone { $_[0]->new->ioloop($_[0]->ioloop) }
63              
64 11     11 1 90 sub finally { shift->_finally(1, @_) }
65              
66             sub map {
67 4 100   4 1 6505 my ($class, $options, $cb, @items) = (shift, ref $_[0] eq 'HASH' ? shift : {}, @_);
68              
69 4 100 66     54 return $class->all(map { $_->$cb } @items) if !$options->{concurrency} || @items <= $options->{concurrency};
  6         17  
70              
71 2         20 my @start = map { $_->$cb } splice @items, 0, $options->{concurrency};
  6         16  
72 2         14 my @wait = map { $start[0]->clone } 0 .. $#items;
  6         14  
73              
74             my $start_next = sub {
75 7 100   7   20 return () unless my $item = shift @items;
76 4         10 my ($start_next, $chain) = (__SUB__, shift @wait);
77 4         14 $_->$cb->then(sub { $chain->resolve(@_); $start_next->() }, sub { $chain->reject(@_); @items = () }) for $item;
  4         20  
  4         12  
  0         0  
  0         0  
78 4         15 return ();
79 2         25 };
80              
81 2     3   8 $_->then($start_next, sub { }) for @start;
82              
83 2         6 return $class->all(@start, @wait);
84             }
85              
86             sub new {
87 790     790 1 80029 my $self = shift->SUPER::new;
88 790         1126 $self->{debug} = Mojo::Exception->new->trace if DEBUG;
89 790 100   1   1662 shift->(sub { $self->resolve(@_) }, sub { $self->reject(@_) }) if @_;
  1         7  
  1         6  
90 790         2397 return $self;
91             }
92              
93 3     3 1 23 sub race { _all(1, @_) }
94              
95 99     99 1 4804 sub reject { shift->_settle('reject', @_) }
96 764     764 1 5405 sub resolve { shift->_settle('resolve', @_) }
97              
98             sub then {
99 535     535 1 1461 my ($self, $resolve, $reject) = @_;
100              
101 535         1107 my $new = $self->clone;
102 535         1068 $self->{handled} = 1;
103 535     421   797 push @{$self->{resolve}}, sub { _then_cb($new, $resolve, 'resolve', @_) };
  535         2224  
  421         988  
104 535     88   927 push @{$self->{reject}}, sub { _then_cb($new, $reject, 'reject', @_) };
  535         1758  
  88         210  
105              
106 535 100       1420 $self->_defer if $self->{results};
107              
108 535         1562 return $new;
109             }
110              
111 3     3 1 4497 sub timer { shift->_timer('resolve', @_) }
112 3     3 1 4660 sub timeout { shift->_timer('reject', @_) }
113              
114             sub wait {
115 46     46 1 150 my $self = shift;
116 46 50       134 return if (my $loop = $self->ioloop)->is_running;
117 46         132 my $done;
118 46     27   315 $self->_finally(0, sub { $done++; $loop->stop })->catch(sub { });
  46         91  
  46         188  
119 46         317 $loop->start until $done;
120             }
121              
122             sub _all {
123 18     18   66 my ($type, $class, @promises) = @_;
124              
125 18         62 my $all = $promises[0]->clone;
126 18         48 my $results = [];
127 18         43 my $remaining = scalar @promises;
128 18         66 for my $i (0 .. $#promises) {
129              
130             # "race"
131 58 100       175 if ($type == 1) {
    100          
    100          
132 8     5   30 $promises[$i]->then(sub { $all->resolve(@_); () }, sub { $all->reject(@_); () });
  5     0   42  
  5         7  
  3         18  
  3         12  
133             }
134              
135             # "all"
136             elsif ($type == 2) {
137             $promises[$i]->then(
138             sub {
139 32     32   80 $results->[$i] = [@_];
140 32 100       111 $all->resolve(@$results) if --$remaining <= 0;
141 32         60 return ();
142             },
143 4     4   13 sub { $all->reject(@_); () }
  4         8  
144 38         248 );
145             }
146              
147             # "any"
148             elsif ($type == 3) {
149             $promises[$i]->then(
150 2     2   10 sub { $all->resolve(@_); () },
  2         4  
151             sub {
152 4     4   14 $results->[$i] = [@_];
153 4 100       12 $all->reject(@$results) if --$remaining <= 0;
154 4         7 return ();
155             }
156 6         29 );
157             }
158              
159             # "all_settled"
160             else {
161             $promises[$i]->then(
162             sub {
163 5     5   24 $results->[$i] = {status => 'fulfilled', value => [@_]};
164 5 100       18 $all->resolve(@$results) if --$remaining <= 0;
165 5         8 return ();
166             },
167             sub {
168 1     1   3 $results->[$i] = {status => 'rejected', reason => [@_]};
169 1 50       14 $all->resolve(@$results) if --$remaining <= 0;
170 1         3 return ();
171             }
172 6         39 );
173             }
174             }
175              
176 18         289 return $all;
177             }
178              
179             sub _await {
180 0     0   0 my ($method, $class) = (shift, shift);
181 0         0 my $promise = $class->$method(@_);
182 0         0 $promise->{cycle} = $promise;
183 0         0 return $promise;
184             }
185              
186             sub _defer {
187 862     862   1398 my $self = shift;
188              
189 862 50       1879 return unless my $results = $self->{results};
190 862 100       1934 my $cbs = $self->{status} eq 'resolve' ? $self->{resolve} : $self->{reject};
191 862         1658 @{$self}{qw(cycle resolve reject)} = (undef, [], []);
  862         3202  
192              
193 862     862   2531 $self->ioloop->next_tick(sub { $_->(@$results) for @$cbs });
  862         2979  
194             }
195              
196             sub _finally {
197 57     57   249 my ($self, $handled, $finally) = @_;
198              
199 57         132 my $new = $self->clone;
200             my $cb = sub {
201 57     57   193 my @results = @_;
202 57         182 $new->resolve($finally->())->then(sub {@results});
  55         137  
203 57         271 };
204              
205 57         122 my $before = $self->{handled};
206 57         204 $self->catch($cb);
207 57         152 my $next = $self->then($cb);
208 57 100 100     338 delete $self->{handled} if !$before && !$handled;
209              
210 57         335 return $next;
211             }
212              
213             sub _settle {
214 863     863   1947 my ($self, $status, @results) = @_;
215              
216 863   100     3745 my $thenable = blessed $results[0] && $results[0]->can('then');
217 863 100       2389 unless (ref $self) {
218 34 50 66     156 return $results[0] if $thenable && $status eq 'resolve' && $results[0]->isa('Mojo::Promise');
      66        
219 30         143 $self = $self->new;
220             }
221              
222 859 100 100     2829 if ($thenable && $status eq 'resolve') {
    100          
223 67     19   402 $results[0]->then(sub { $self->resolve(@_); () }, sub { $self->reject(@_); () });
  61         286  
  61         160  
  6         20  
  6         9  
224             }
225             elsif (!$self->{results}) {
226 761         1325 @{$self}{qw(results status)} = (\@results, $status);
  761         1983  
227 761         1693 $self->_defer;
228             }
229              
230 859         5122 return $self;
231             }
232              
233             sub _settle_await {
234 0     0   0 my ($status, $self, @results) = @_;
235 0     0   0 return $results[0]->then(sub { $self->resolve(@_); () }, sub { $self->reject(@_); () })
  0         0  
  0         0  
  0         0  
236 0 0 0     0 if blessed $results[0] && $results[0]->can('then');
237 0 0       0 @{$self}{qw(results status)} = ([@results], $status) if !$self->{results};
  0         0  
238 0         0 $self->_defer;
239             }
240              
241             sub _then_cb {
242 509     509   1195 my ($new, $cb, $method, @results) = @_;
243              
244 509 100       1452 return $new->$method(@results) unless defined $cb;
245              
246 343         487 my @res;
247 343 100       533 return $new->reject($@) unless eval { @res = $cb->(@results); 1 };
  343         820  
  341         1230  
248 341         860 return $new->resolve(@res);
249             }
250              
251             sub _timer {
252 6     6   27 my ($self, $method, $after, @results) = @_;
253 6 100       29 $self = $self->new unless ref $self;
254 6 100 100     40 $results[0] = 'Promise timeout' if $method eq 'reject' && !@results;
255 6     6   32 $self->ioloop->timer($after => sub { $self->$method(@results) });
  6         98  
256 6         91 return $self;
257             }
258              
259             1;
260              
261             =encoding utf8
262              
263             =head1 NAME
264              
265             Mojo::Promise - Promises/A+
266              
267             =head1 SYNOPSIS
268              
269             use Mojo::Promise;
270             use Mojo::UserAgent;
271              
272             # Wrap continuation-passing style APIs with promises
273             my $ua = Mojo::UserAgent->new;
274             sub get_p {
275             my $promise = Mojo::Promise->new;
276             $ua->get(@_ => sub ($ua, $tx) {
277             my $err = $tx->error;
278             if (!$err || $err->{code}) { $promise->resolve($tx) }
279             else { $promise->reject($err->{message}) }
280             });
281             return $promise;
282             }
283              
284             # Perform non-blocking operations sequentially
285             get_p('https://mojolicious.org')->then(sub ($mojo) {
286             say $mojo->res->code;
287             return get_p('https://metacpan.org');
288             })->then(sub ($cpan) {
289             say $cpan->res->code;
290             })->catch(sub ($err) {
291             warn "Something went wrong: $err";
292             })->wait;
293              
294             # Synchronize non-blocking operations (all)
295             my $mojo = get_p('https://mojolicious.org');
296             my $cpan = get_p('https://metacpan.org');
297             Mojo::Promise->all($mojo, $cpan)->then(sub ($mojo, $cpan) {
298             say $mojo->[0]->res->code;
299             say $cpan->[0]->res->code;
300             })->catch(sub ($err) {
301             warn "Something went wrong: $err";
302             })->wait;
303              
304             # Synchronize non-blocking operations (race)
305             my $mojo = get_p('https://mojolicious.org');
306             my $cpan = get_p('https://metacpan.org');
307             Mojo::Promise->race($mojo, $cpan)->then(sub ($tx) {
308             say $tx->req->url, ' won!';
309             })->catch(sub ($err) {
310             warn "Something went wrong: $err";
311             })->wait;
312              
313             =head1 DESCRIPTION
314              
315             L is a Perl-ish implementation of L and a superset of L
316             Promises|https://duckduckgo.com/?q=\mdn%20Promise>.
317              
318             =head1 STATES
319              
320             A promise is an object representing the eventual completion or failure of a non-blocking operation. It allows
321             non-blocking functions to return values, like blocking functions. But instead of immediately returning the final value,
322             the non-blocking function returns a promise to supply the value at some point in the future.
323              
324             A promise can be in one of three states:
325              
326             =over 2
327              
328             =item pending
329              
330             Initial state, neither fulfilled nor rejected.
331              
332             =item fulfilled
333              
334             Meaning that the operation completed successfully.
335              
336             =item rejected
337              
338             Meaning that the operation failed.
339              
340             =back
341              
342             A pending promise can either be fulfilled with a value or rejected with a reason. When either happens, the associated
343             handlers queued up by a promise's L method are called.
344              
345             =head1 ATTRIBUTES
346              
347             L implements the following attributes.
348              
349             =head2 ioloop
350              
351             my $loop = $promise->ioloop;
352             $promise = $promise->ioloop(Mojo::IOLoop->new);
353              
354             Event loop object to control, defaults to the global L singleton. Note that this attribute is weakened.
355              
356             =head1 METHODS
357              
358             L inherits all methods from L and implements the following new ones.
359              
360             =head2 all
361              
362             my $new = Mojo::Promise->all(@promises);
363              
364             Returns a new L object that either fulfills when all of the passed L objects have
365             fulfilled or rejects as soon as one of them rejects. If the returned promise fulfills, it is fulfilled with the values
366             from the fulfilled promises in the same order as the passed promises.
367              
368             =head2 all_settled
369              
370             my $new = Mojo::Promise->all_settled(@promises);
371              
372             Returns a new L object that fulfills when all of the passed L objects have fulfilled or
373             rejected, with hash references that describe the outcome of each promise.
374              
375             =head2 any
376              
377             my $new = Mojo::Promise->any(@promises);
378              
379             Returns a new L object that fulfills as soon as one of the passed L objects fulfills,
380             with the value from that promise.
381              
382             =head2 catch
383              
384             my $new = $promise->catch(sub {...});
385              
386             Appends a rejection handler callback to the promise, and returns a new L object resolving to the return
387             value of the callback if it is called, or to its original fulfillment value if the promise is instead fulfilled.
388              
389             # Longer version
390             my $new = $promise->then(undef, sub {...});
391              
392             # Pass along the rejection reason
393             $promise->catch(sub (@reason) {
394             warn "Something went wrong: $reason[0]";
395             return @reason;
396             });
397              
398             # Change the rejection reason
399             $promise->catch(sub (@reason) { "This is bad: $reason[0]" });
400              
401             =head2 clone
402              
403             my $new = $promise->clone;
404              
405             Return a new L object cloned from this promise that is still pending.
406              
407             =head2 finally
408              
409             my $new = $promise->finally(sub {...});
410              
411             Appends a fulfillment and rejection handler to the promise, and returns a new L object resolving to the
412             original fulfillment value or rejection reason.
413              
414             # Do something on fulfillment and rejection
415             $promise->finally(sub { say "We are done!" });
416              
417             =head2 map
418              
419             my $new = Mojo::Promise->map(sub {...}, @items);
420             my $new = Mojo::Promise->map({concurrency => 3}, sub {...}, @items);
421              
422             Apply a function that returns a L to each item in a list of items while optionally limiting concurrency.
423             Returns a L that collects the results in the same manner as L. If any item's promise is rejected,
424             any remaining items which have not yet been mapped will not be.
425              
426             # Perform 3 requests at a time concurrently
427             Mojo::Promise->map({concurrency => 3}, sub { $ua->get_p($_) }, @urls)
428             ->then(sub{ say $_->[0]->res->dom->at('title')->text for @_ });
429              
430             These options are currently available:
431              
432             =over 2
433              
434             =item concurrency
435              
436             concurrency => 3
437              
438             The maximum number of items that are in progress at the same time.
439              
440             =back
441              
442             =head2 new
443              
444             my $promise = Mojo::Promise->new;
445             my $promise = Mojo::Promise->new(sub {...});
446              
447             Construct a new L object.
448              
449             # Wrap a continuation-passing style API
450             my $promise = Mojo::Promise->new(sub ($resolve, $reject) {
451             Mojo::IOLoop->timer(5 => sub {
452             if (int rand 2) { $resolve->('Lucky!') }
453             else { $reject->('Unlucky!') }
454             });
455             });
456              
457             =head2 race
458              
459             my $new = Mojo::Promise->race(@promises);
460              
461             Returns a new L object that fulfills or rejects as soon as one of the passed L objects
462             fulfills or rejects, with the value or reason from that promise.
463              
464             =head2 reject
465              
466             my $new = Mojo::Promise->reject(@reason);
467             $promise = $promise->reject(@reason);
468              
469             Build rejected L object or reject the promise with one or more rejection reasons.
470              
471             # Longer version
472             my $promise = Mojo::Promise->new->reject(@reason);
473              
474             =head2 resolve
475              
476             my $new = Mojo::Promise->resolve(@value);
477             $promise = $promise->resolve(@value);
478              
479             Build resolved L object or resolve the promise with one or more fulfillment values.
480              
481             # Longer version
482             my $promise = Mojo::Promise->new->resolve(@value);
483              
484             =head2 then
485              
486             my $new = $promise->then(sub {...});
487             my $new = $promise->then(sub {...}, sub {...});
488             my $new = $promise->then(undef, sub {...});
489              
490             Appends fulfillment and rejection handlers to the promise, and returns a new L object resolving to the
491             return value of the called handler.
492              
493             # Pass along the fulfillment value or rejection reason
494             $promise->then(
495             sub (@value) {
496             say "The result is $value[0]";
497             return @value;
498             },
499             sub (@reason) {
500             warn "Something went wrong: $reason[0]";
501             return @reason;
502             }
503             );
504              
505             # Change the fulfillment value or rejection reason
506             $promise->then(
507             sub (@value) { return "This is good: $value[0]" },
508             sub (@reason) { return "This is bad: $reason[0]" }
509             );
510              
511             =head2 timer
512              
513             my $new = Mojo::Promise->timer(5 => 'Success!');
514             $promise = $promise->timer(5 => 'Success!');
515             $promise = $promise->timer(5);
516              
517             Create a new L object with a timer or attach a timer to an existing promise. The promise will be
518             resolved after the given amount of time in seconds with or without a value.
519              
520             =head2 timeout
521              
522             my $new = Mojo::Promise->timeout(5 => 'Timeout!');
523             $promise = $promise->timeout(5 => 'Timeout!');
524             $promise = $promise->timeout(5);
525              
526             Create a new L object with a timeout or attach a timeout to an existing promise. The promise will be
527             rejected after the given amount of time in seconds with a reason, which defaults to C.
528              
529             =head2 wait
530              
531             $promise->wait;
532              
533             Start L and stop it again once the promise has been fulfilled or rejected, does nothing when L is
534             already running.
535              
536             =head1 DEBUGGING
537              
538             You can set the C environment variable to get some advanced diagnostics information printed to
539             C.
540              
541             MOJO_PROMISE_DEBUG=1
542              
543             =head1 SEE ALSO
544              
545             L, L, L.
546              
547             =cut