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

Comparing AnyEvent-Fork/Fork.pm (file contents):
Revision 1.41 by root, Mon Apr 8 03:20:53 2013 UTC vs.
Revision 1.42 by root, Mon Apr 8 05:44:23 2013 UTC

… …
384our $EARLY; 384our $EARLY;
385 385
386# the empty template process 386# the empty template process
387our $TEMPLATE; 387our $TEMPLATE;
388 388
389sub QUEUE() { 0 }
390sub FH() { 1 }
391sub WW() { 2 }
392sub PID() { 3 }
393sub CB() { 4 }
394
395sub _new {
396 my ($self, $fh, $pid) = @_;
397
398 AnyEvent::Util::fh_nonblocking $fh, 1;
399
400 $self = bless [
401 [], # write queue - strings or fd's
402 $fh,
403 undef, # AE watcher
404 $pid,
405 ], $self;
406
407 $self
408}
409
389sub _cmd { 410sub _cmd {
390 my $self = shift; 411 my $self = shift;
391 412
392 # ideally, we would want to use "a (w/a)*" as format string, but perl 413 # ideally, we would want to use "a (w/a)*" as format string, but perl
393 # versions from at least 5.8.9 to 5.16.3 are all buggy and can't unpack 414 # versions from at least 5.8.9 to 5.16.3 are all buggy and can't unpack
394 # it. 415 # it.
395 push @{ $self->[2] }, pack "a L/a*", $_[0], $_[1]; 416 push @{ $self->[QUEUE] }, pack "a L/a*", $_[0], $_[1];
396 417
397 $self->[3] ||= AE::io $self->[1], 1, sub { 418 $self->[WW] ||= AE::io $self->[FH], 1, sub {
398 do { 419 do {
399 # send the next "thing" in the queue - either a reference to an fh, 420 # send the next "thing" in the queue - either a reference to an fh,
400 # or a plain string. 421 # or a plain string.
401 422
402 if (ref $self->[2][0]) { 423 if (ref $self->[QUEUE][0]) {
403 # send fh 424 # send fh
404 unless (IO::FDPass::send fileno $self->[1], fileno ${ $self->[2][0] }) { 425 unless (IO::FDPass::send fileno $self->[FH], fileno ${ $self->[QUEUE][0] }) {
405 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK; 426 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK;
406 undef $self->[3]; 427 undef $self->[WW];
407 die "AnyEvent::Fork: file descriptor send failure: $!"; 428 die "AnyEvent::Fork: file descriptor send failure: $!";
408 } 429 }
409 430
410 shift @{ $self->[2] }; 431 shift @{ $self->[QUEUE] };
411 432
412 } else { 433 } else {
413 # send string 434 # send string
414 my $len = syswrite $self->[1], $self->[2][0]; 435 my $len = syswrite $self->[FH], $self->[QUEUE][0];
415 436
416 unless ($len) { 437 unless ($len) {
417 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK; 438 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK;
418 undef $self->[3]; 439 undef $self->[3];
419 die "AnyEvent::Fork: command write failure: $!"; 440 die "AnyEvent::Fork: command write failure: $!";
420 } 441 }
421 442
422 substr $self->[2][0], 0, $len, ""; 443 substr $self->[QUEUE][0], 0, $len, "";
423 shift @{ $self->[2] } unless length $self->[2][0]; 444 shift @{ $self->[QUEUE] } unless length $self->[QUEUE][0];
424 } 445 }
425 } while @{ $self->[2] }; 446 } while @{ $self->[QUEUE] };
426 447
427 # everything written 448 # everything written
428 undef $self->[3]; 449 undef $self->[WW];
429 450
430 # invoke run callback, if any 451 # invoke run callback, if any
431 $self->[4]->($self->[1]) if $self->[4]; 452 $self->[CB]->($self->[FH]) if $self->[CB];
432 }; 453 };
433 454
434 () # make sure we don't leak the watcher 455 () # make sure we don't leak the watcher
435}
436
437sub _new {
438 my ($self, $fh, $pid) = @_;
439
440 AnyEvent::Util::fh_nonblocking $fh, 1;
441
442 $self = bless [
443 $pid,
444 $fh,
445 [], # write queue - strings or fd's
446 undef, # AE watcher
447 ], $self;
448
449 $self
450} 456}
451 457
452# fork template from current process, used by AnyEvent::Fork::Early/Template 458# fork template from current process, used by AnyEvent::Fork::Early/Template
453sub _new_fork { 459sub _new_fork {
454 my ($fh, $slave) = AnyEvent::Util::portable_socketpair; 460 my ($fh, $slave) = AnyEvent::Util::portable_socketpair;
… …
587AnyEvent::Fork itself. 593AnyEvent::Fork itself.
588 594
589=cut 595=cut
590 596
591sub pid { 597sub pid {
592 $_[0][0] 598 $_[0][PID]
593} 599}
594 600
595=item $proc = $proc->eval ($perlcode, @args) 601=item $proc = $proc->eval ($perlcode, @args)
596 602
597Evaluates the given C<$perlcode> as ... perl code, while setting C<@_> to 603Evaluates the given C<$perlcode> as ... perl code, while setting C<@_> to
… …
664sub send_fh { 670sub send_fh {
665 my ($self, @fh) = @_; 671 my ($self, @fh) = @_;
666 672
667 for my $fh (@fh) { 673 for my $fh (@fh) {
668 $self->_cmd ("h"); 674 $self->_cmd ("h");
669 push @{ $self->[2] }, \$fh; 675 push @{ $self->[QUEUE] }, \$fh;
670 } 676 }
671 677
672 $self 678 $self
673} 679}
674 680
… …
760=cut 766=cut
761 767
762sub run { 768sub run {
763 my ($self, $func, $cb) = @_; 769 my ($self, $func, $cb) = @_;
764 770
765 $self->[4] = $cb; 771 $self->[CB] = $cb;
766 $self->_cmd (r => $func); 772 $self->_cmd (r => $func);
767} 773}
768 774
769=back 775=back
770 776

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines