File Coverage

blib/lib/Promise/XS/Promise.pm
Criterion Covered Total %
statement 30 38 78.9
branch 3 6 50.0
condition n/a
subroutine 8 9 88.8
pod 0 2 0.0
total 41 55 74.5


line stmt bran cond sub pod time code
1             package Promise::XS::Promise;
2              
3 26     26   174 use strict;
  26         51  
  26         716  
4 26     26   134 use warnings;
  26         51  
  26         11710  
5              
6             =encoding utf-8
7              
8             =head1 NAME
9              
10             Promise::XS::Promise - promise object
11              
12             =head1 SYNOPSIS
13              
14             See L.
15              
16             =head1 DESCRIPTION
17              
18             This is L’s actual promise object class. It implements
19             these methods:
20              
21             =over
22              
23             =item * C
24              
25             =item * C
26              
27             =item * C
28              
29             =back
30              
31             … which behave as they normally do in promise implementations.
32              
33             Additionally, C and C may be used, thus:
34              
35             my $p3 = Promise::XS::Promise->all( $p1, $p2, .. );
36             my $p3 = Promise::XS::Promise->race( $p1, $p2, .. );
37              
38             … or, just:
39              
40             my $p3 = ref($p1)->all( $p1, $p2, .. );
41             my $p3 = ref($p1)->race( $p1, $p2, .. );
42              
43             … or even:
44              
45             my $p3 = $p1->all( $p1, $p2, .. );
46             my $p3 = $p1->race( $p1, $p2, .. );
47              
48             (Note the repetition of $p1 in these last examples!)
49              
50             =head1 NOTES
51              
52             Subclassing this class won’t work because the above-named methods always
53             return instances of (exactly) this class. That may change eventually,
54             but for now this is what’s what.
55              
56             =cut
57              
58             # Lifted from Promises::collect
59             sub all {
60 3     3 0 117 my $all_done = Promise::XS::resolved();
61              
62 3         11 for my $p (@_[1 .. $#_]) {
63 6         11 my @results;
64             $all_done = $all_done->then( sub {
65 6     6   14 @results = @_;
66 6         43 return $p;
67 6     6   38 } )->then(sub{ ( @results, [ @_ ] ) } );
  6         47  
68             }
69              
70 3         22 return $all_done;
71             }
72              
73             # Lifted from Promise::ES6
74             sub race {
75 2     2 0 9 my $deferred = Promise::XS::Deferred::create();
76              
77 2         4 my $is_done;
78              
79 2         6 my $promise = $deferred->promise();
80              
81             my $on_resolve_cr = sub {
82 4 100   4   15 return if $is_done;
83 2         3 $is_done = 1;
84              
85 2         8 $deferred->resolve(@_);
86              
87             # Proactively eliminate references:
88 2         10 undef $deferred;
89 2         9 };
90              
91             my $on_reject_cr = sub {
92 0 0   0   0 return if $is_done;
93 0         0 $is_done = 1;
94              
95 0         0 $deferred->reject(@_);
96              
97             # Proactively eliminate references:
98 0         0 undef $deferred;
99 2         6 };
100              
101 2         8 for my $given_promise (@_[1 .. $#_]) {
102 4         25 $given_promise->then($on_resolve_cr, $on_reject_cr);
103             }
104              
105 2         17 return $promise;
106             }
107              
108             sub _warn_unhandled {
109 10     10   38654 my (@reasons) = @_;
110              
111 10         20 my $class = __PACKAGE__;
112              
113 10 50       30 if (1 == @reasons) {
114 10         93 warn "$class: Unhandled rejection: $reasons[0]\n";
115             }
116             else {
117 0           my $total = 0 + @reasons;
118              
119 0           for my $i ( 0 .. $#reasons ) {
120 0           my $num = 1 + $i;
121              
122 0           warn "$class: Unhandled rejection ($num of $total): $reasons[$i]\n";
123             }
124             }
125             }
126              
127             #----------------------------------------------------------------------
128             # Future::AsyncAwait interface
129             #----------------------------------------------------------------------
130              
131             #sub AWAIT_ON_READY {
132             # $_[0]->finally($_[1])->catch(\&AWAIT_CHAIN_CANCEL);
133             #}
134              
135             1;