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.40 by root, Sat Apr 6 22:41:56 2013 UTC vs.
Revision 1.42 by root, Mon Apr 8 05:44:23 2013 UTC

… …
372 372
373use IO::FDPass; 373use IO::FDPass;
374 374
375our $VERSION = 0.6; 375our $VERSION = 0.6;
376 376
377our $PERL; # the path to the perl interpreter, deduces with various forms of magic
378
379=over 4 377=over 4
380 378
381=back 379=back
382 380
383=cut 381=cut
… …
385# the early fork template process 383# the early fork template process
386our $EARLY; 384our $EARLY;
387 385
388# the empty template process 386# the empty template process
389our $TEMPLATE; 387our $TEMPLATE;
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}
390 409
391sub _cmd { 410sub _cmd {
392 my $self = shift; 411 my $self = shift;
393 412
394 # 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
395 # 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
396 # it. 415 # it.
397 push @{ $self->[2] }, pack "a L/a*", $_[0], $_[1]; 416 push @{ $self->[QUEUE] }, pack "a L/a*", $_[0], $_[1];
398 417
399 $self->[3] ||= AE::io $self->[1], 1, sub { 418 $self->[WW] ||= AE::io $self->[FH], 1, sub {
400 do { 419 do {
401 # 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,
402 # or a plain string. 421 # or a plain string.
403 422
404 if (ref $self->[2][0]) { 423 if (ref $self->[QUEUE][0]) {
405 # send fh 424 # send fh
406 unless (IO::FDPass::send fileno $self->[1], fileno ${ $self->[2][0] }) { 425 unless (IO::FDPass::send fileno $self->[FH], fileno ${ $self->[QUEUE][0] }) {
407 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK; 426 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK;
408 undef $self->[3]; 427 undef $self->[WW];
409 die "AnyEvent::Fork: file descriptor send failure: $!"; 428 die "AnyEvent::Fork: file descriptor send failure: $!";
410 } 429 }
411 430
412 shift @{ $self->[2] }; 431 shift @{ $self->[QUEUE] };
413 432
414 } else { 433 } else {
415 # send string 434 # send string
416 my $len = syswrite $self->[1], $self->[2][0]; 435 my $len = syswrite $self->[FH], $self->[QUEUE][0];
417 436
418 unless ($len) { 437 unless ($len) {
419 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK; 438 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK;
420 undef $self->[3]; 439 undef $self->[3];
421 die "AnyEvent::Fork: command write failure: $!"; 440 die "AnyEvent::Fork: command write failure: $!";
422 } 441 }
423 442
424 substr $self->[2][0], 0, $len, ""; 443 substr $self->[QUEUE][0], 0, $len, "";
425 shift @{ $self->[2] } unless length $self->[2][0]; 444 shift @{ $self->[QUEUE] } unless length $self->[QUEUE][0];
426 } 445 }
427 } while @{ $self->[2] }; 446 } while @{ $self->[QUEUE] };
428 447
429 # everything written 448 # everything written
430 undef $self->[3]; 449 undef $self->[WW];
431 450
432 # invoke run callback, if any 451 # invoke run callback, if any
433 $self->[4]->($self->[1]) if $self->[4]; 452 $self->[CB]->($self->[FH]) if $self->[CB];
434 }; 453 };
435 454
436 () # make sure we don't leak the watcher 455 () # make sure we don't leak the watcher
437}
438
439sub _new {
440 my ($self, $fh, $pid) = @_;
441
442 AnyEvent::Util::fh_nonblocking $fh, 1;
443
444 $self = bless [
445 $pid,
446 $fh,
447 [], # write queue - strings or fd's
448 undef, # AE watcher
449 ], $self;
450
451 $self
452} 456}
453 457
454# fork template from current process, used by AnyEvent::Fork::Early/Template 458# fork template from current process, used by AnyEvent::Fork::Early/Template
455sub _new_fork { 459sub _new_fork {
456 my ($fh, $slave) = AnyEvent::Util::portable_socketpair; 460 my ($fh, $slave) = AnyEvent::Util::portable_socketpair;
… …
461 if ($pid eq 0) { 465 if ($pid eq 0) {
462 require AnyEvent::Fork::Serve; 466 require AnyEvent::Fork::Serve;
463 $AnyEvent::Fork::Serve::OWNER = $parent; 467 $AnyEvent::Fork::Serve::OWNER = $parent;
464 close $fh; 468 close $fh;
465 $0 = "$_[1] of $parent"; 469 $0 = "$_[1] of $parent";
466 $SIG{CHLD} = 'IGNORE';
467 AnyEvent::Fork::Serve::serve ($slave); 470 AnyEvent::Fork::Serve::serve ($slave);
468 exit 0; 471 exit 0;
469 } elsif (!$pid) { 472 } elsif (!$pid) {
470 die "AnyEvent::Fork::Early/Template: unable to fork template process: $!"; 473 die "AnyEvent::Fork::Early/Template: unable to fork template process: $!";
471 } 474 }
… …
590AnyEvent::Fork itself. 593AnyEvent::Fork itself.
591 594
592=cut 595=cut
593 596
594sub pid { 597sub pid {
595 $_[0][0] 598 $_[0][PID]
596} 599}
597 600
598=item $proc = $proc->eval ($perlcode, @args) 601=item $proc = $proc->eval ($perlcode, @args)
599 602
600Evaluates the given C<$perlcode> as ... perl code, while setting C<@_> to 603Evaluates the given C<$perlcode> as ... perl code, while setting C<@_> to
… …
667sub send_fh { 670sub send_fh {
668 my ($self, @fh) = @_; 671 my ($self, @fh) = @_;
669 672
670 for my $fh (@fh) { 673 for my $fh (@fh) {
671 $self->_cmd ("h"); 674 $self->_cmd ("h");
672 push @{ $self->[2] }, \$fh; 675 push @{ $self->[QUEUE] }, \$fh;
673 } 676 }
674 677
675 $self 678 $self
676} 679}
677 680
… …
763=cut 766=cut
764 767
765sub run { 768sub run {
766 my ($self, $func, $cb) = @_; 769 my ($self, $func, $cb) = @_;
767 770
768 $self->[4] = $cb; 771 $self->[CB] = $cb;
769 $self->_cmd (r => $func); 772 $self->_cmd (r => $func);
770} 773}
771 774
772=back 775=back
773 776

Diff Legend

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