… | |
… | |
67 | |
67 | |
68 | our $idle; # idle handler |
68 | our $idle; # idle handler |
69 | our $main; # main coroutine |
69 | our $main; # main coroutine |
70 | our $current; # current coroutine |
70 | our $current; # current coroutine |
71 | |
71 | |
72 | our $VERSION = 5.0; |
72 | our $VERSION = "5.0"; |
73 | |
73 | |
74 | our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub); |
74 | our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub); |
75 | our %EXPORT_TAGS = ( |
75 | our %EXPORT_TAGS = ( |
76 | prio => [qw(PRIO_MAX PRIO_HIGH PRIO_NORMAL PRIO_LOW PRIO_IDLE PRIO_MIN)], |
76 | prio => [qw(PRIO_MAX PRIO_HIGH PRIO_NORMAL PRIO_LOW PRIO_IDLE PRIO_MIN)], |
77 | ); |
77 | ); |
… | |
… | |
135 | $idle = sub { |
135 | $idle = sub { |
136 | require Carp; |
136 | require Carp; |
137 | Carp::croak ("FATAL: deadlock detected"); |
137 | Carp::croak ("FATAL: deadlock detected"); |
138 | }; |
138 | }; |
139 | |
139 | |
140 | sub _cancel { |
|
|
141 | my ($self) = @_; |
|
|
142 | |
|
|
143 | # free coroutine data and mark as destructed |
|
|
144 | $self->_destroy |
|
|
145 | or return; |
|
|
146 | |
|
|
147 | # call all destruction callbacks |
|
|
148 | $_->(@{$self->{_status}}) |
|
|
149 | for @{ delete $self->{_on_destroy} || [] }; |
|
|
150 | } |
|
|
151 | |
|
|
152 | # this coroutine is necessary because a coroutine |
140 | # this coroutine is necessary because a coroutine |
153 | # cannot destroy itself. |
141 | # cannot destroy itself. |
154 | our @destroy; |
142 | our @destroy; |
155 | our $manager; |
143 | our $manager; |
156 | |
144 | |
157 | $manager = new Coro sub { |
145 | $manager = new Coro sub { |
158 | while () { |
146 | while () { |
159 | (shift @destroy)->_cancel |
147 | Coro::_cancel shift @destroy |
160 | while @destroy; |
148 | while @destroy; |
161 | |
149 | |
162 | &schedule; |
150 | &schedule; |
163 | } |
151 | } |
164 | }; |
152 | }; |
… | |
… | |
319 | you cannot free all of them, so if a coroutine that is not the main |
307 | you cannot free all of them, so if a coroutine that is not the main |
320 | program calls this function, there will be some one-time resource leak. |
308 | program calls this function, there will be some one-time resource leak. |
321 | |
309 | |
322 | =cut |
310 | =cut |
323 | |
311 | |
324 | sub terminate { |
|
|
325 | $current->{_status} = [@_]; |
|
|
326 | push @destroy, $current; |
|
|
327 | $manager->ready; |
|
|
328 | do { &schedule } while 1; |
|
|
329 | } |
|
|
330 | |
|
|
331 | sub killall { |
312 | sub killall { |
332 | for (Coro::State::list) { |
313 | for (Coro::State::list) { |
333 | $_->cancel |
314 | $_->cancel |
334 | if $_ != $current && UNIVERSAL::isa $_, "Coro"; |
315 | if $_ != $current && UNIVERSAL::isa $_, "Coro"; |
335 | } |
316 | } |
… | |
… | |
390 | } else { |
371 | } else { |
391 | $self->{_status} = [@_]; |
372 | $self->{_status} = [@_]; |
392 | $self->_cancel; |
373 | $self->_cancel; |
393 | } |
374 | } |
394 | } |
375 | } |
|
|
376 | |
|
|
377 | =item $coroutine->schedule_to |
|
|
378 | |
|
|
379 | Puts the current coroutine to sleep (like C<Coro::schedule>), but instead |
|
|
380 | of continuing with the next coro from the ready queue, always switch to |
|
|
381 | the given coroutine object (regardless of priority etc.). The readyness |
|
|
382 | state of that coroutine isn't changed. |
|
|
383 | |
|
|
384 | This is an advanced method for special cases - I'd love to hear about any |
|
|
385 | uses for this one. |
|
|
386 | |
|
|
387 | =item $coroutine->cede_to |
|
|
388 | |
|
|
389 | Like C<schedule_to>, but puts the current coroutine into the ready |
|
|
390 | queue. This has the effect of temporarily switching to the given |
|
|
391 | coroutine, and continuing some time later. |
|
|
392 | |
|
|
393 | This is an advanced method for special cases - I'd love to hear about any |
|
|
394 | uses for this one. |
395 | |
395 | |
396 | =item $coroutine->throw ([$scalar]) |
396 | =item $coroutine->throw ([$scalar]) |
397 | |
397 | |
398 | If C<$throw> is specified and defined, it will be thrown as an exception |
398 | If C<$throw> is specified and defined, it will be thrown as an exception |
399 | inside the coroutine at the next convenient point in time. Otherwise |
399 | inside the coroutine at the next convenient point in time. Otherwise |