File Coverage

blib/lib/Promise/ES6.pm
Criterion Covered Total %
statement 72 82 87.8
branch 18 22 81.8
condition n/a
subroutine 19 21 90.4
pod 1 7 14.2
total 110 132 83.3


line stmt bran cond sub pod time code
1             package Promise::ES6;
2              
3 42     42   4794207 use strict;
  42         460  
  42         1179  
4 42     42   235 use warnings;
  42         95  
  42         10175  
5              
6             our $VERSION = '0.27_90';
7              
8             =encoding utf-8
9              
10             =head1 NAME
11              
12             Promise::ES6 - ES6-style promises in Perl
13              
14             =head1 SYNOPSIS
15              
16             use Promise::ES6;
17              
18             # OPTIONAL. And see below for other options.
19             Promise::ES6::use_event('IO::Async', $loop);
20              
21             my $promise = Promise::ES6->new( sub {
22             my ($resolve_cr, $reject_cr) = @_;
23              
24             # ..
25             } );
26              
27             my $promise2 = $promise->then( sub { .. }, sub { .. } );
28              
29             my $promise3 = $promise->catch( sub { .. } );
30              
31             my $promise4 = $promise->finally( sub { .. } );
32              
33             my $resolved = Promise::ES6->resolve(5);
34             my $rejected = Promise::ES6->reject('nono');
35              
36             my $all_promise = Promise::ES6->all( \@promises );
37              
38             my $race_promise = Promise::ES6->race( \@promises );
39              
40             my $allsettled_promise = Promise::ES6->allSettled( \@promises );
41              
42             =head1 DESCRIPTION
43              
44             =begin html
45              
46             Coverage Status
47              
48             =end html
49              
50             This module provides a Perl implementation of L, a useful pattern
51             for coordinating asynchronous tasks.
52              
53             Unlike most other promise implementations on CPAN, this module
54             mimics ECMAScript 6’s L
55             interface. As the SYNOPSIS above shows, you can thus use patterns from
56             JavaScript in Perl with only minimal changes needed to accommodate language
57             syntax.
58              
59             This is a rewrite of an earlier module, L. It fixes several
60             bugs and superfluous dependencies in the original.
61              
62             =head1 STATUS
63              
64             This module is in use in production and, backed by a pretty extensive
65             set of regression tests, may be considered stable.
66              
67             =head1 INTERFACE NOTES
68              
69             =over
70              
71             =item * Promise resolutions and rejections accept exactly one argument,
72             not a list.
73              
74             =item * Unhandled rejections are reported via C. (See below
75             for details.)
76              
77             =item * Undefined or empty rejection values trigger a warning.
78             This provides the same value as Perl’s own warning on C.
79              
80             =item * The L avoids testing the case where an “executor”
81             function’s resolve callback itself receives another promise, e.g.:
82              
83             my $p = Promise::ES6->new( sub ($res) {
84             $res->( Promise::ES6->resolve(123) );
85             } );
86              
87             What will $p’s resolution value be? 123, or the promise that wraps it?
88              
89             This module favors conformity with the ES6 standard, which
90             L that $p’s resolution value be 123.
91              
92             =back
93              
94             =head1 COMPATIBILITY
95              
96             This module considers any object that has a C method to be a promise.
97             Note that, in the case of L, this will yield a “false-positive”, as
98             Future is not compatible with promises.
99              
100             (See L for more tools to interact with L.)
101              
102             =head1 B ASYNC/AWAIT SUPPORT
103              
104             This module implements L. This lets you do
105             nifty stuff like:
106              
107             use Future::AsyncAwait;
108              
109             async sub do_stuff {
110             my $foo = await fetch_number_p();
111              
112             # NB: The real return is a promise that provides this value:
113             return 1 + $foo;
114             }
115              
116             my $one_plus_number = await do_stuff();
117              
118             … which roughly equates to:
119              
120             sub do_stuff {
121             return fetch_number_p()->then( sub { 1 + $foo } );
122             }
123              
124             do_stuff->then( sub {
125             $one_plus_number = shift;
126             } );
127              
128             =head1 UNHANDLED REJECTIONS
129              
130             This module’s handling of unhandled rejections has changed over time.
131             The current behavior is: if any rejected promise is DESTROYed without first
132             having received a catch callback, a warning is thrown.
133              
134             =head1 SYNCHRONOUS VS. ASYNCHRONOUS OPERATION
135              
136             In JavaScript, the following …
137              
138             Promise.resolve().then( () => console.log(1) );
139             console.log(2);
140              
141             … will log C<2> then C<1> because JavaScript’s C defers execution
142             of its callbacks until between iterations through JavaScript’s event loop.
143              
144             Perl, of course, has no built-in event loop. This module accommodates that by
145             implementing B promises by default rather than asynchronous ones.
146             This means that all promise callbacks run I rather than between
147             iterations of an event loop. As a result, this:
148              
149             Promise::ES6->resolve(0)->then( sub { print 1 } );
150             print 2;
151              
152             … will print C<12> instead of C<21>.
153              
154             One effect of this is that Promise::ES6, in its default configuration, is
155             agnostic regarding event loop interfaces: no special configuration is needed
156             for any specific event loop. In fact, you don’t even I an event loop
157             at all, which might be useful for abstracting over whether a given
158             function works synchronously or asynchronously.
159              
160             The disadvantage of synchronous promises—besides not being I the same
161             promises that we expect from JS—is that recursive promises can exceed
162             call stack limits. For example, the following (admittedly contrived) code:
163              
164             my @nums = 1 .. 1000;
165              
166             sub _remove {
167             if (@nums) {
168             Promise::ES6->resolve(shift @nums)->then(\&_remove);
169             }
170             }
171              
172             _remove();
173              
174             … will eventually fail because it will reach Perl’s call stack size limit.
175              
176             That problem probably won’t affect most applications. The best way to
177             avoid it, though, is to use asynchronous promises, à la JavaScript.
178              
179             To do that, first choose one of the following event interfaces:
180              
181             =over
182              
183             =item * L
184              
185             =item * L
186              
187             =item * L (part of L)
188              
189             =back
190              
191             Then, before you start creating promises, do this:
192              
193             Promise::ES6::use_event('AnyEvent');
194              
195             … or:
196              
197             Promise::ES6::use_event('Mojo::IOLoop');
198              
199             … or:
200              
201             Promise::ES6::use_event('IO::Async', $loop);
202              
203             That’s it! Promise::ES6 instances will now work asynchronously rather than
204             synchronously.
205              
206             Note that this changes Promise::ES6 I. In IO::Async’s case, it
207             won’t increase the passed-in L instance’s reference count,
208             but if that loop object goes away, Promise::ES6 won’t work until you call
209             C again.
210              
211             B For the best long-term scalability and flexibility,
212             your code should work with either synchronous or asynchronous promises.
213              
214             =head1 CANCELLATION
215              
216             Promises have never provided a standardized solution for cancellation—i.e.,
217             aborting an in-process operation. If you need this functionality, then, you’ll
218             have to implement it yourself. Two ways of doing this are:
219              
220             =over
221              
222             =item * Subclass Promise::ES6 and provide cancellation logic in that
223             subclass. See L’s implementation for an
224             example of this.
225              
226             =item * Implement the cancellation on a request object that your
227             “promise-creator” also consumes. This is probably the more straightforward
228             approach but requires that there
229             be some object or ID besides the promise that uniquely identifies the action
230             to be canceled. See L for an example of this approach.
231              
232             =back
233              
234             You’ll need to decide if it makes more sense for your application to leave
235             a canceled query in the “pending” state or to “settle” (i.e., resolve or
236             reject) it. All things being equal, I feel the first approach is the most
237             intuitive, while the latter ends up being “cleaner”.
238              
239             Of note: L implements native cancellation.
240              
241             =head1 MEMORY LEAKS
242              
243             It’s easy to create inadvertent memory leaks using promises in Perl.
244             Here are a few “pointers” (heh) to bear in mind:
245              
246             =over
247              
248             =item * Any Promise::ES6 instances that are created while
249             C<$Promise::ES6::DETECT_MEMORY_LEAKS> is set to a truthy value are
250             “leak-detect-enabled”, which means that if they survive until their original
251             process’s global destruction, a warning is triggered. You should normally
252             enable this flag in a development environment.
253              
254             =item * If your application needs recursive promises (e.g., to poll
255             iteratively for completion of a task), the C feature (i.e.,
256             C<__SUB__>) may help you avoid memory leaks. In Perl versions that don’t
257             support this feature (i.e., anything pre-5.16) you can imitate it thus:
258              
259             use constant _has_current_sub => eval "use feature 'current_sub'";
260              
261             use if _has_current_sub(), feature => 'current_sub';
262              
263             my $cb;
264             $cb = sub {
265             my $current_sub = do {
266             no strict 'subs';
267             _has_current_sub() ? __SUB__ : eval '$cb';
268             };
269             }
270              
271             Of course, it’s better if you can avoid doing that. :)
272              
273             =item * Garbage collection before Perl 5.18 seems to have been buggy.
274             If you work with such versions and end up chasing leaks,
275             try manually deleting as many references/closures as possible. See
276             F for a notated example.
277              
278             You may also (counterintuitively, IMO) find that this:
279              
280             my ($resolve, $reject);
281              
282             my $promise = Promise::ES6->new( sub { ($resolve, $reject) = @_ } );
283              
284             # … etc.
285              
286             … works better than:
287              
288             my $promise = Promise::ES6->new( sub {
289             my ($resolve, $reject) = @_;
290              
291             # … etc.
292             } );
293              
294             =back
295              
296             =head1 SEE ALSO
297              
298             If you’re not sure of what promises are, there are several good
299             introductions to the topic. You might start with
300             L.
301              
302             L is my refactor of L. It’s a lot like
303             this library but implemented mostly in XS for speed.
304              
305             L is another pure-Perl Promise implementation.
306              
307             L fills a role similar to that of promises. Much of the IO::Async
308             ecosystem assumes (or strongly encourages) its use.
309              
310             CPAN contains a number of other modules that implement promises. I think
311             mine are the nicest :), but YMMV. Enjoy!
312              
313             =head1 LICENSE & COPYRIGHT
314              
315             Copyright 2019-2021 Gasper Software Consulting.
316              
317             This library is licensed under the same terms as Perl itself.
318              
319             =cut
320              
321             #----------------------------------------------------------------------
322              
323             our $DETECT_MEMORY_LEAKS;
324              
325 0     0   0 sub __default_postpone { die 'NO EVENT' }
326             *_postpone = \&__default_postpone;
327              
328             our $_EVENT;
329              
330             sub use_event {
331 0     0 0 0 my ($name, @args) = @_;
332              
333 0         0 my $modname = $name;
334 0         0 $modname =~ tr<:><>d;
335              
336 0         0 my @saved_errs = ($!, $@);
337              
338 0         0 require "Promise/ES6/Event/$modname.pm";
339              
340 0         0 ($!, $@) = @saved_errs;
341              
342 0         0 $_EVENT = $name;
343              
344             # We need to block redefinition and (for AnyEvent)
345             # prototype-mismatch warnings.
346 42     42   330 no warnings 'all';
  42         102  
  42         39776  
347 0         0 *_postpone = "Promise::ES6::Event::$modname"->can('get_postpone')->(@args);
348              
349 0         0 return;
350             }
351              
352 20     20 0 1546 sub catch { $_[0]->then( undef, $_[1] ) }
353              
354             sub resolve {
355 20     20 1 13902 my ( $class, $value ) = @_;
356              
357 20     20   154 $class->new( sub { $_[0]->($value) } );
  20         84  
358             }
359              
360             sub reject {
361 13     13 0 12840 my ( $class, @reason ) = @_;
362              
363 13     13   66 $class->new( sub { $_[1]->(@reason) } );
  13         46  
364             }
365              
366             sub all {
367 12     12 0 5111 my ( $class, $iterable ) = @_;
368 12 100       76 my @promises = map { UNIVERSAL::can( $_, 'then' ) ? $_ : $class->resolve($_) } @$iterable;
  23         212  
369              
370 12         23 my @values;
371              
372             return $class->new(
373             sub {
374 12     12   39 my ( $resolve, $reject ) = @_;
375 12         28 my $unresolved_size = scalar(@promises);
376              
377 12         71 my $settled;
378              
379 12 100       43 if ($unresolved_size) {
380 10         29 my $p = 0;
381              
382             my $on_reject_cr = sub {
383              
384             # Needed because we might get multiple failures:
385 7 100       15 return if $settled;
386              
387 5         6 $settled = 1;
388 5         11 $reject->(@_);
389 10         52 };
390              
391 10         31 for my $promise (@promises) {
392 23         41 my $p = $p++;
393              
394             $promise->then(
395             $settled ? undef : sub {
396 15 50       37 return if $settled;
397              
398 15         35 $values[$p] = $_[0];
399              
400 15         20 $unresolved_size--;
401 15 100       43 return if $unresolved_size > 0;
402              
403 5         9 $settled = 1;
404 5         31 $resolve->( \@values );
405             },
406 23 100       121 $on_reject_cr,
407             );
408             }
409             }
410             else {
411 2         6 $resolve->( [] );
412             }
413             }
414 12         93 );
415             }
416              
417             sub race {
418 5     5 0 3965 my ( $class, $iterable ) = @_;
419 5 50       131 my @promises = map { UNIVERSAL::can( $_, 'then' ) ? $_ : $class->resolve($_) } @$iterable;
  10         180  
420              
421 5         31 my ( $resolve, $reject );
422              
423             # Perl 5.16 and earlier leak memory when the callbacks are handled
424             # inside the closure here.
425             my $new = $class->new(
426             sub {
427 5     5   38 ( $resolve, $reject ) = @_;
428             }
429 5         209 );
430              
431 5         39 my $is_done;
432              
433             my $on_resolve_cr = sub {
434 3 50   3   8 return if $is_done;
435 3         6 $is_done = 1;
436              
437 3         26 $resolve->( $_[0] );
438              
439             # Proactively eliminate references:
440 3         35 $resolve = $reject = undef;
441 5         140 };
442              
443             my $on_reject_cr = sub {
444 3 100   3   9 return if $is_done;
445 2         7 $is_done = 1;
446              
447 2         9 $reject->( $_[0] );
448              
449             # Proactively eliminate references:
450 2         66 $resolve = $reject = undef;
451 5         76 };
452              
453 5         25 for my $promise (@promises) {
454 10         150 $promise->then( $on_resolve_cr, $on_reject_cr );
455             }
456              
457 5         48 return $new;
458             }
459              
460             sub _aS_fulfilled {
461 4     4   14 return { status => 'fulfilled', value => $_[0] };
462             }
463              
464             sub _aS_rejected {
465 1     1   6 return { status => 'rejected', reason => $_[0] };
466             }
467              
468             sub _aS_map {
469 5     5   15 return $_->then( \&_aS_fulfilled, \&_aS_rejected );
470             }
471              
472             sub allSettled {
473 3     3 0 924 my ( $class, $iterable ) = @_;
474              
475 3 100       7 my @promises = map { UNIVERSAL::can( $_, 'then' ) ? $_ : $class->resolve($_) } @$iterable;
  5         21  
476              
477 3         6 @promises = map( _aS_map, @promises );
478              
479 3         13 return $class->all( \@promises );
480             }
481              
482             #----------------------------------------------------------------------
483              
484             my $loaded_backend;
485              
486             BEGIN {
487             # Put this block at the end so that the backend module
488             # can override any of the above.
489              
490 42 50   42   332 return if $loaded_backend;
491              
492 42         96 $loaded_backend = 1;
493              
494             # These don’t exist yet but will:
495 42         84 if (0 && !$ENV{'PROMISE_ES6_PP'} && eval { require Promise::ES6::XS }) {
496             require Promise::ES6::Backend::XS;
497             }
498              
499             # Fall back to pure Perl:
500             else {
501 42         20286 require Promise::ES6::Backend::PP;
502             }
503             }
504              
505             1;