ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Coro.pm
(Generate patch)

Comparing Coro/Coro.pm (file contents):
Revision 1.136 by root, Sat Sep 22 22:59:31 2007 UTC vs.
Revision 1.142 by root, Tue Oct 2 23:16:24 2007 UTC

50 50
51our $idle; # idle handler 51our $idle; # idle handler
52our $main; # main coroutine 52our $main; # main coroutine
53our $current; # current coroutine 53our $current; # current coroutine
54 54
55our $VERSION = '3.7'; 55our $VERSION = '3.8';
56 56
57our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub); 57our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub);
58our %EXPORT_TAGS = ( 58our %EXPORT_TAGS = (
59 prio => [qw(PRIO_MAX PRIO_HIGH PRIO_NORMAL PRIO_LOW PRIO_IDLE PRIO_MIN)], 59 prio => [qw(PRIO_MAX PRIO_HIGH PRIO_NORMAL PRIO_LOW PRIO_IDLE PRIO_MIN)],
60); 60);
116=cut 116=cut
117 117
118$main->{desc} = "[main::]"; 118$main->{desc} = "[main::]";
119 119
120# maybe some other module used Coro::Specific before... 120# maybe some other module used Coro::Specific before...
121$main->{specific} = $current->{specific} 121$main->{_specific} = $current->{_specific}
122 if $current; 122 if $current;
123 123
124_set_current $main; 124_set_current $main;
125 125
126sub current() { $current } 126sub current() { $current }
151 # free coroutine data and mark as destructed 151 # free coroutine data and mark as destructed
152 $self->_destroy 152 $self->_destroy
153 or return; 153 or return;
154 154
155 # call all destruction callbacks 155 # call all destruction callbacks
156 $_->(@{$self->{status}}) 156 $_->(@{$self->{_status}})
157 for @{(delete $self->{destroy_cb}) || []}; 157 for @{(delete $self->{_on_destroy}) || []};
158} 158}
159 159
160# this coroutine is necessary because a coroutine 160# this coroutine is necessary because a coroutine
161# cannot destroy itself. 161# cannot destroy itself.
162my @destroy; 162my @destroy;
308 308
309=item terminate [arg...] 309=item terminate [arg...]
310 310
311Terminates the current coroutine with the given status values (see L<cancel>). 311Terminates the current coroutine with the given status values (see L<cancel>).
312 312
313=item killall
314
315Kills/terminates/cancels all coroutines except the currently running
316one. This is useful after a fork, either in the child or the parent, as
317usually only one of them should inherit the running coroutines.
318
313=cut 319=cut
314 320
315sub terminate { 321sub terminate {
316 $current->cancel (@_); 322 $current->cancel (@_);
323}
324
325sub killall {
326 for (Coro::State::list) {
327 $_->cancel
328 if $_ != $current && UNIVERSAL::isa $_, "Coro";
329 }
317} 330}
318 331
319=back 332=back
320 333
321# dynamic methods 334# dynamic methods
365 378
366=cut 379=cut
367 380
368sub cancel { 381sub cancel {
369 my $self = shift; 382 my $self = shift;
370 $self->{status} = [@_]; 383 $self->{_status} = [@_];
371 384
372 if ($current == $self) { 385 if ($current == $self) {
373 push @destroy, $self; 386 push @destroy, $self;
374 $manager->ready; 387 $manager->ready;
375 &schedule while 1; 388 &schedule while 1;
387=cut 400=cut
388 401
389sub join { 402sub join {
390 my $self = shift; 403 my $self = shift;
391 404
392 unless ($self->{status}) { 405 unless ($self->{_status}) {
393 my $current = $current; 406 my $current = $current;
394 407
395 push @{$self->{destroy_cb}}, sub { 408 push @{$self->{_on_destroy}}, sub {
396 $current->ready; 409 $current->ready;
397 undef $current; 410 undef $current;
398 }; 411 };
399 412
400 &schedule while $current; 413 &schedule while $current;
401 } 414 }
402 415
403 wantarray ? @{$self->{status}} : $self->{status}[0]; 416 wantarray ? @{$self->{_status}} : $self->{_status}[0];
404} 417}
405 418
406=item $coroutine->on_destroy (\&cb) 419=item $coroutine->on_destroy (\&cb)
407 420
408Registers a callback that is called when this coroutine gets destroyed, 421Registers a callback that is called when this coroutine gets destroyed,
412=cut 425=cut
413 426
414sub on_destroy { 427sub on_destroy {
415 my ($self, $cb) = @_; 428 my ($self, $cb) = @_;
416 429
417 push @{ $self->{destroy_cb} }, $cb; 430 push @{ $self->{_on_destroy} }, $cb;
418} 431}
419 432
420=item $oldprio = $coroutine->prio ($newprio) 433=item $oldprio = $coroutine->prio ($newprio)
421 434
422Sets (or gets, if the argument is missing) the priority of the 435Sets (or gets, if the argument is missing) the priority of the
446 459
447=item $olddesc = $coroutine->desc ($newdesc) 460=item $olddesc = $coroutine->desc ($newdesc)
448 461
449Sets (or gets in case the argument is missing) the description for this 462Sets (or gets in case the argument is missing) the description for this
450coroutine. This is just a free-form string you can associate with a coroutine. 463coroutine. This is just a free-form string you can associate with a coroutine.
464
465This method simply sets the C<< $coroutine->{desc} >> member to the given string. You
466can modify this member directly if you wish.
451 467
452=cut 468=cut
453 469
454sub desc { 470sub desc {
455 my $old = $_[0]{desc}; 471 my $old = $_[0]{desc};

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines