File Coverage

blib/lib/ZMQ/Raw/Loop/Promise.pm
Criterion Covered Total %
statement 70 76 92.1
branch 12 16 75.0
condition 1 3 33.3
subroutine 18 19 94.7
pod 7 7 100.0
total 108 121 89.2


line stmt bran cond sub pod time code
1             package ZMQ::Raw::Loop::Promise;
2             $ZMQ::Raw::Loop::Promise::VERSION = '0.37';
3 14     88   74 use strict;
  14         127  
  14         323  
4 14     14   55 use warnings;
  14         20  
  14         262  
5 14     14   51 use Carp;
  14         20  
  14         1034  
6              
7 0     0   0 sub CLONE_SKIP { 1 }
8              
9             my @attributes;
10              
11             BEGIN
12             {
13 14     14   65 @attributes = qw/
14             loop
15             status
16             /;
17              
18 14     14   96 no strict 'refs';
  14         26  
  14         1008  
19 14         30 foreach my $accessor (@attributes)
20             {
21 28         411 *{$accessor} = sub
22             {
23 74 100   74   2042 @_ > 1 ? $_[0]->{$accessor} = $_[1] : $_[0]->{$accessor}
24 28         73 };
25             }
26             }
27              
28 14     14   70 use ZMQ::Raw;
  14         36  
  14         336  
29              
30 14     14   66 use constant PLANNED => 0;
  14         39  
  14         1361  
31 14     14   77 use constant KEPT => 1;
  14         18  
  14         710  
32 14     14   80 use constant BROKEN => 2;
  14         18  
  14         7060  
33              
34             =head1 NAME
35              
36             ZMQ::Raw::Loop::Promise - Promise class
37              
38             =head1 VERSION
39              
40             version 0.37
41              
42             =head1 DESCRIPTION
43              
44             A L represents a promise
45              
46             B: The API of this module is unstable and may change without warning
47             (any change will be appropriately documented in the changelog).
48              
49             =head1 SYNOPSIS
50              
51             use ZMQ::Raw;
52              
53             my $context = ZMQ::Raw::Context->new;
54             my $loop = ZMQ::Raw::Loop->new ($context);
55              
56             my $promise = ZMQ::Raw::Loop::Promise->new ($loop);
57             $promise->then (sub
58             {
59             my $promise = shift;
60             print "Promise kept/broken: ", $promise->result, "\n";
61             }
62             );
63              
64             my $timer = ZMQ::Raw::Loop::Timer->new (
65             timer => ZMQ::Raw::Timer->new ($context, after => 100),
66             on_timeout => sub
67             {
68             $promise->keep ('done');
69             }
70             );
71              
72             $loop->add ($timer);
73             $loop->run();
74              
75             =head1 METHODS
76              
77             =head2 new( $loop )
78              
79             Create a new promise.
80              
81             =head2 status( )
82              
83             Get the status of the promise. One of C, C or C.
84              
85             =head2 await( )
86              
87             Wait for the promise to be kept or broken.
88              
89             =head2 result( )
90              
91             Wait for the promise to be kept or broken, if its kept the result will be
92             returned, otherwise throws the cause.
93              
94             =head2 cause( )
95              
96             Get the reason why the promise was broken. This method will croak if the promise
97             is still planned or has been kept.
98              
99             =head2 break( $result )
100              
101             Break the promise, setting the cause to C<$result>.
102              
103             =head2 keep( $result )
104              
105             Keep the promise, setting its result to C<$result>.
106              
107             =head2 then( \&callback )
108              
109             Schedule C<\&callback> to be fired when the promise is either kept or broken. Returns
110             a new C.
111              
112             =cut
113              
114             sub new
115             {
116 9     9 1 22 my ($this, $loop) = @_;
117              
118 9   33     27 my $class = ref ($this) || $this;
119 9         23 my $self =
120             {
121             loop => $loop,
122             status => &PLANNED,
123             };
124              
125 9         18 return bless $self, $class;
126             }
127              
128             sub await
129             {
130 4     4 1 10 my ($this) = @_;
131              
132 4         7 while ($this->status == &PLANNED)
133             {
134 10 50       31 if ($this->loop->terminated)
135             {
136 0         0 $this->break();
137 0         0 return;
138             }
139              
140 10         23 $this->loop->run_one;
141             }
142             }
143              
144             sub keep
145             {
146 7     7 1 26 my ($this, $result) = @_;
147              
148 7         14 $this->{result} = $result;
149 7         21 $this->status (&KEPT);
150              
151 7 100       17 if ($this->{then})
152             {
153 5         5 &{$this->{then}}();
  5         25  
154 5         30 $this->{then} = undef;
155             }
156             }
157              
158             sub break
159             {
160 2     2 1 33 my ($this, $cause) = @_;
161              
162 2         4 $this->{cause} = $cause;
163 2         9 $this->status (&BROKEN);
164              
165 2 100       5 if ($this->{then})
166             {
167 1         2 &{$this->{then}}();
  1         4  
168 1         5 $this->{then} = undef;
169             }
170             }
171              
172             sub then
173             {
174 6     6 1 14 my ($this, $then) = @_;
175              
176 6 50       10 if ($this->status != &PLANNED)
177             {
178 0         0 croak "promise not planned";
179             }
180              
181 6         12 my $promise = ZMQ::Raw::Loop::Promise->new ($this->loop);
182              
183             $this->{then} = sub
184             {
185 6     6   15 my $result = eval { &{$then} ($this) };
  6         9  
  6         15  
186 6 100       39 if ($@)
187             {
188 1         5 $promise->break ($@);
189 1         2 return;
190             }
191              
192 5         13 $promise->keep ($result);
193 6         18 };
194              
195 6         16 return $promise;
196             }
197              
198             sub result
199             {
200 3     3 1 2879 my ($this) = @_;
201              
202 3         8 $this->await();
203 3 50       22 if ($this->status == &KEPT)
204             {
205 3         10 return $this->{result};
206             }
207              
208 0         0 die $this->{cause};
209             }
210              
211             sub cause
212             {
213 2     2 1 5 my ($this) = @_;
214              
215 2 50       5 if ($this->status != &BROKEN)
216             {
217 0         0 croak "promise not broken";
218             }
219              
220 2         14 return $this->{cause};
221             }
222              
223             =head1 CONSTANTS
224              
225             =head2 PLANNED
226              
227             The promise is still planned.
228              
229             =head2 KEPT
230              
231             The promise has been kept.
232              
233             =head2 BROKEN
234              
235             The promise was broken.
236              
237             =for Pod::Coverage loop
238              
239             =head1 AUTHOR
240              
241             Jacques Germishuys
242              
243             =head1 LICENSE AND COPYRIGHT
244              
245             Copyright 2017 Jacques Germishuys.
246              
247             This program is free software; you can redistribute it and/or modify it
248             under the terms of either: the GNU General Public License as published
249             by the Free Software Foundation; or the Artistic License.
250              
251             See http://dev.perl.org/licenses/ for more information.
252              
253             =cut
254              
255             1; # End of ZMQ::Raw::Loop::Promise