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.39 by root, Sat Apr 6 22:39:37 2013 UTC vs.
Revision 1.44 by root, Thu Apr 18 10:49:59 2013 UTC

… …
34This module only creates processes and lets you pass file handles and 34This module only creates processes and lets you pass file handles and
35strings to it, and run perl code. It does not implement any kind of RPC - 35strings to it, and run perl code. It does not implement any kind of RPC -
36there is no back channel from the process back to you, and there is no RPC 36there is no back channel from the process back to you, and there is no RPC
37or message passing going on. 37or message passing going on.
38 38
39If you need some form of RPC, you can either implement it yourself 39If you need some form of RPC, you could use the L<AnyEvent::Fork::RPC>
40in whatever way you like, use some message-passing module such 40companion module, which adds simple RPC/job queueing to a process created
41as L<AnyEvent::MP>, some pipe such as L<AnyEvent::ZeroMQ>, use 41by this module.
42L<AnyEvent::Handle> on both sides to send e.g. JSON or Storable messages, 42
43and so on. 43Or you can implement it yourself in whatever way you like, use some
44message-passing module such as L<AnyEvent::MP>, some pipe such as
45L<AnyEvent::ZeroMQ>, use L<AnyEvent::Handle> on both sides to send
46e.g. JSON or Storable messages, and so on.
44 47
45=head2 COMPARISON TO OTHER MODULES 48=head2 COMPARISON TO OTHER MODULES
46 49
47There is an abundance of modules on CPAN that do "something fork", such as 50There is an abundance of modules on CPAN that do "something fork", such as
48L<Parallel::ForkManager>, L<AnyEvent::ForkManager>, L<AnyEvent::Worker> 51L<Parallel::ForkManager>, L<AnyEvent::ForkManager>, L<AnyEvent::Worker>
… …
221 } 224 }
222 } 225 }
223 226
224=head2 use AnyEvent::Fork as a faster fork+exec 227=head2 use AnyEvent::Fork as a faster fork+exec
225 228
226This runs C</bin/echo hi>, with stdandard output redirected to /tmp/log 229This runs C</bin/echo hi>, with standard output redirected to F</tmp/log>
227and standard error redirected to the communications socket. It is usually 230and standard error redirected to the communications socket. It is usually
228faster than fork+exec, but still lets you prepare the environment. 231faster than fork+exec, but still lets you prepare the environment.
229 232
230 open my $output, ">/tmp/log" or die "$!"; 233 open my $output, ">/tmp/log" or die "$!";
231 234
232 AnyEvent::Fork 235 AnyEvent::Fork
233 ->new 236 ->new
234 ->eval (' 237 ->eval ('
238 # compile a helper function for later use
235 sub run { 239 sub run {
236 my ($fh, $output, @cmd) = @_; 240 my ($fh, $output, @cmd) = @_;
237 241
238 # perl will clear close-on-exec on STDOUT/STDERR 242 # perl will clear close-on-exec on STDOUT/STDERR
239 open STDOUT, ">&", $output or die; 243 open STDOUT, ">&", $output or die;
… …
369use AnyEvent; 373use AnyEvent;
370use AnyEvent::Util (); 374use AnyEvent::Util ();
371 375
372use IO::FDPass; 376use IO::FDPass;
373 377
374our $VERSION = 0.5; 378our $VERSION = 0.6;
375
376our $PERL; # the path to the perl interpreter, deduces with various forms of magic
377
378=over 4
379
380=back
381
382=cut
383 379
384# the early fork template process 380# the early fork template process
385our $EARLY; 381our $EARLY;
386 382
387# the empty template process 383# the empty template process
388our $TEMPLATE; 384our $TEMPLATE;
385
386sub QUEUE() { 0 }
387sub FH() { 1 }
388sub WW() { 2 }
389sub PID() { 3 }
390sub CB() { 4 }
391
392sub _new {
393 my ($self, $fh, $pid) = @_;
394
395 AnyEvent::Util::fh_nonblocking $fh, 1;
396
397 $self = bless [
398 [], # write queue - strings or fd's
399 $fh,
400 undef, # AE watcher
401 $pid,
402 ], $self;
403
404 $self
405}
389 406
390sub _cmd { 407sub _cmd {
391 my $self = shift; 408 my $self = shift;
392 409
393 # ideally, we would want to use "a (w/a)*" as format string, but perl 410 # ideally, we would want to use "a (w/a)*" as format string, but perl
394 # versions from at least 5.8.9 to 5.16.3 are all buggy and can't unpack 411 # versions from at least 5.8.9 to 5.16.3 are all buggy and can't unpack
395 # it. 412 # it.
396 push @{ $self->[2] }, pack "a L/a*", $_[0], $_[1]; 413 push @{ $self->[QUEUE] }, pack "a L/a*", $_[0], $_[1];
397 414
398 $self->[3] ||= AE::io $self->[1], 1, sub { 415 $self->[WW] ||= AE::io $self->[FH], 1, sub {
399 do { 416 do {
400 # send the next "thing" in the queue - either a reference to an fh, 417 # send the next "thing" in the queue - either a reference to an fh,
401 # or a plain string. 418 # or a plain string.
402 419
403 if (ref $self->[2][0]) { 420 if (ref $self->[QUEUE][0]) {
404 # send fh 421 # send fh
405 unless (IO::FDPass::send fileno $self->[1], fileno ${ $self->[2][0] }) { 422 unless (IO::FDPass::send fileno $self->[FH], fileno ${ $self->[QUEUE][0] }) {
406 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK; 423 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK;
407 undef $self->[3]; 424 undef $self->[WW];
408 die "AnyEvent::Fork: file descriptor send failure: $!"; 425 die "AnyEvent::Fork: file descriptor send failure: $!";
409 } 426 }
410 427
411 shift @{ $self->[2] }; 428 shift @{ $self->[QUEUE] };
412 429
413 } else { 430 } else {
414 # send string 431 # send string
415 my $len = syswrite $self->[1], $self->[2][0]; 432 my $len = syswrite $self->[FH], $self->[QUEUE][0];
416 433
417 unless ($len) { 434 unless ($len) {
418 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK; 435 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK;
419 undef $self->[3]; 436 undef $self->[3];
420 die "AnyEvent::Fork: command write failure: $!"; 437 die "AnyEvent::Fork: command write failure: $!";
421 } 438 }
422 439
423 substr $self->[2][0], 0, $len, ""; 440 substr $self->[QUEUE][0], 0, $len, "";
424 shift @{ $self->[2] } unless length $self->[2][0]; 441 shift @{ $self->[QUEUE] } unless length $self->[QUEUE][0];
425 } 442 }
426 } while @{ $self->[2] }; 443 } while @{ $self->[QUEUE] };
427 444
428 # everything written 445 # everything written
429 undef $self->[3]; 446 undef $self->[WW];
430 447
431 # invoke run callback, if any 448 # invoke run callback, if any
432 $self->[4]->($self->[1]) if $self->[4]; 449 $self->[CB]->($self->[FH]) if $self->[CB];
433 }; 450 };
434 451
435 () # make sure we don't leak the watcher 452 () # make sure we don't leak the watcher
436}
437
438sub _new {
439 my ($self, $fh, $pid) = @_;
440
441 AnyEvent::Util::fh_nonblocking $fh, 1;
442
443 $self = bless [
444 $pid,
445 $fh,
446 [], # write queue - strings or fd's
447 undef, # AE watcher
448 ], $self;
449
450 $self
451} 453}
452 454
453# fork template from current process, used by AnyEvent::Fork::Early/Template 455# fork template from current process, used by AnyEvent::Fork::Early/Template
454sub _new_fork { 456sub _new_fork {
455 my ($fh, $slave) = AnyEvent::Util::portable_socketpair; 457 my ($fh, $slave) = AnyEvent::Util::portable_socketpair;
… …
460 if ($pid eq 0) { 462 if ($pid eq 0) {
461 require AnyEvent::Fork::Serve; 463 require AnyEvent::Fork::Serve;
462 $AnyEvent::Fork::Serve::OWNER = $parent; 464 $AnyEvent::Fork::Serve::OWNER = $parent;
463 close $fh; 465 close $fh;
464 $0 = "$_[1] of $parent"; 466 $0 = "$_[1] of $parent";
465 $SIG{CHLD} = 'IGNORE';
466 AnyEvent::Fork::Serve::serve ($slave); 467 AnyEvent::Fork::Serve::serve ($slave);
467 exit 0; 468 exit 0;
468 } elsif (!$pid) { 469 } elsif (!$pid) {
469 die "AnyEvent::Fork::Early/Template: unable to fork template process: $!"; 470 die "AnyEvent::Fork::Early/Template: unable to fork template process: $!";
470 } 471 }
… …
589AnyEvent::Fork itself. 590AnyEvent::Fork itself.
590 591
591=cut 592=cut
592 593
593sub pid { 594sub pid {
594 $_[0][0] 595 $_[0][PID]
595} 596}
596 597
597=item $proc = $proc->eval ($perlcode, @args) 598=item $proc = $proc->eval ($perlcode, @args)
598 599
599Evaluates the given C<$perlcode> as ... perl code, while setting C<@_> to 600Evaluates the given C<$perlcode> as ... Perl code, while setting C<@_> to
600the strings specified by C<@args>, in the "main" package. 601the strings specified by C<@args>, in the "main" package.
601 602
602This call is meant to do any custom initialisation that might be required 603This call is meant to do any custom initialisation that might be required
603(for example, the C<require> method uses it). It's not supposed to be used 604(for example, the C<require> method uses it). It's not supposed to be used
604to completely take over the process, use C<run> for that. 605to completely take over the process, use C<run> for that.
… …
666sub send_fh { 667sub send_fh {
667 my ($self, @fh) = @_; 668 my ($self, @fh) = @_;
668 669
669 for my $fh (@fh) { 670 for my $fh (@fh) {
670 $self->_cmd ("h"); 671 $self->_cmd ("h");
671 push @{ $self->[2] }, \$fh; 672 push @{ $self->[QUEUE] }, \$fh;
672 } 673 }
673 674
674 $self 675 $self
675} 676}
676 677
… …
762=cut 763=cut
763 764
764sub run { 765sub run {
765 my ($self, $func, $cb) = @_; 766 my ($self, $func, $cb) = @_;
766 767
767 $self->[4] = $cb; 768 $self->[CB] = $cb;
768 $self->_cmd (r => $func); 769 $self->_cmd (r => $func);
769} 770}
770 771
771=back 772=back
772 773
… …
800So how can C<< AnyEvent->new >> be faster than a standard fork, even 801So how can C<< AnyEvent->new >> be faster than a standard fork, even
801though it uses the same operations, but adds a lot of overhead? 802though it uses the same operations, but adds a lot of overhead?
802 803
803The difference is simply the process size: forking the 5MB process takes 804The difference is simply the process size: forking the 5MB process takes
804so much longer than forking the 2.5MB template process that the extra 805so much longer than forking the 2.5MB template process that the extra
805overhead introduced is canceled out. 806overhead is canceled out.
806 807
807If the benchmark process grows, the normal fork becomes even slower: 808If the benchmark process grows, the normal fork becomes even slower:
808 809
809 1340 new processes, manual fork of a 20MB process 810 1340 new processes, manual fork of a 20MB process
810 731 new processes, manual fork of a 200MB process 811 731 new processes, manual fork of a 200MB process
… …
870initialising them, for example, by calling C<init Gtk2> manually. 871initialising them, for example, by calling C<init Gtk2> manually.
871 872
872=item exiting calls object destructors 873=item exiting calls object destructors
873 874
874This only applies to users of L<AnyEvent::Fork:Early> and 875This only applies to users of L<AnyEvent::Fork:Early> and
875L<AnyEvent::Fork::Template>, or when initialiasing code creates objects 876L<AnyEvent::Fork::Template>, or when initialising code creates objects
876that reference external resources. 877that reference external resources.
877 878
878When a process created by AnyEvent::Fork exits, it might do so by calling 879When a process created by AnyEvent::Fork exits, it might do so by calling
879exit, or simply letting perl reach the end of the program. At which point 880exit, or simply letting perl reach the end of the program. At which point
880Perl runs all destructors. 881Perl runs all destructors.
… …
907 908
908=head1 SEE ALSO 909=head1 SEE ALSO
909 910
910L<AnyEvent::Fork::Early> (to avoid executing a perl interpreter), 911L<AnyEvent::Fork::Early> (to avoid executing a perl interpreter),
911L<AnyEvent::Fork::Template> (to create a process by forking the main 912L<AnyEvent::Fork::Template> (to create a process by forking the main
912program at a convenient time). 913program at a convenient time), L<AnyEvent::Fork::RPC> (for simple RPC to
914child processes).
913 915
914=head1 AUTHOR 916=head1 AUTHOR AND CONTACT INFORMATION
915 917
916 Marc Lehmann <schmorp@schmorp.de> 918 Marc Lehmann <schmorp@schmorp.de>
917 http://home.schmorp.de/ 919 http://software.schmorp.de/pkg/AnyEvent-Fork
918 920
919=cut 921=cut
920 922
9211 9231
922 924

Diff Legend

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