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.47 by root, Thu Apr 18 20:17:34 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;
… …
250 254
251=head1 CONCEPTS 255=head1 CONCEPTS
252 256
253This module can create new processes either by executing a new perl 257This module can create new processes either by executing a new perl
254process, or by forking from an existing "template" process. 258process, or by forking from an existing "template" process.
259
260All these processes are called "child processes" (whether they are direct
261children or not), while the process that manages them is called the
262"parent process".
255 263
256Each such process comes with its own file handle that can be used to 264Each such process comes with its own file handle that can be used to
257communicate with it (it's actually a socket - one end in the new process, 265communicate with it (it's actually a socket - one end in the new process,
258one end in the main process), and among the things you can do in it are 266one end in the main process), and among the things you can do in it are
259load modules, fork new processes, send file handles to it, and execute 267load modules, fork new processes, send file handles to it, and execute
… …
369use AnyEvent; 377use AnyEvent;
370use AnyEvent::Util (); 378use AnyEvent::Util ();
371 379
372use IO::FDPass; 380use IO::FDPass;
373 381
374our $VERSION = 0.5; 382our $VERSION = 0.7;
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 383
384# the early fork template process 384# the early fork template process
385our $EARLY; 385our $EARLY;
386 386
387# the empty template process 387# the empty template process
388our $TEMPLATE; 388our $TEMPLATE;
389
390sub QUEUE() { 0 }
391sub FH() { 1 }
392sub WW() { 2 }
393sub PID() { 3 }
394sub CB() { 4 }
395
396sub _new {
397 my ($self, $fh, $pid) = @_;
398
399 AnyEvent::Util::fh_nonblocking $fh, 1;
400
401 $self = bless [
402 [], # write queue - strings or fd's
403 $fh,
404 undef, # AE watcher
405 $pid,
406 ], $self;
407
408 $self
409}
389 410
390sub _cmd { 411sub _cmd {
391 my $self = shift; 412 my $self = shift;
392 413
393 # ideally, we would want to use "a (w/a)*" as format string, but perl 414 # 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 415 # versions from at least 5.8.9 to 5.16.3 are all buggy and can't unpack
395 # it. 416 # it.
396 push @{ $self->[2] }, pack "a L/a*", $_[0], $_[1]; 417 push @{ $self->[QUEUE] }, pack "a L/a*", $_[0], $_[1];
397 418
398 $self->[3] ||= AE::io $self->[1], 1, sub { 419 $self->[WW] ||= AE::io $self->[FH], 1, sub {
399 do { 420 do {
400 # send the next "thing" in the queue - either a reference to an fh, 421 # send the next "thing" in the queue - either a reference to an fh,
401 # or a plain string. 422 # or a plain string.
402 423
403 if (ref $self->[2][0]) { 424 if (ref $self->[QUEUE][0]) {
404 # send fh 425 # send fh
405 unless (IO::FDPass::send fileno $self->[1], fileno ${ $self->[2][0] }) { 426 unless (IO::FDPass::send fileno $self->[FH], fileno ${ $self->[QUEUE][0] }) {
406 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK; 427 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK;
407 undef $self->[3]; 428 undef $self->[WW];
408 die "AnyEvent::Fork: file descriptor send failure: $!"; 429 die "AnyEvent::Fork: file descriptor send failure: $!";
409 } 430 }
410 431
411 shift @{ $self->[2] }; 432 shift @{ $self->[QUEUE] };
412 433
413 } else { 434 } else {
414 # send string 435 # send string
415 my $len = syswrite $self->[1], $self->[2][0]; 436 my $len = syswrite $self->[FH], $self->[QUEUE][0];
416 437
417 unless ($len) { 438 unless ($len) {
418 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK; 439 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK;
419 undef $self->[3]; 440 undef $self->[3];
420 die "AnyEvent::Fork: command write failure: $!"; 441 die "AnyEvent::Fork: command write failure: $!";
421 } 442 }
422 443
423 substr $self->[2][0], 0, $len, ""; 444 substr $self->[QUEUE][0], 0, $len, "";
424 shift @{ $self->[2] } unless length $self->[2][0]; 445 shift @{ $self->[QUEUE] } unless length $self->[QUEUE][0];
425 } 446 }
426 } while @{ $self->[2] }; 447 } while @{ $self->[QUEUE] };
427 448
428 # everything written 449 # everything written
429 undef $self->[3]; 450 undef $self->[WW];
430 451
431 # invoke run callback, if any 452 # invoke run callback, if any
432 $self->[4]->($self->[1]) if $self->[4]; 453 $self->[CB]->($self->[FH]) if $self->[CB];
433 }; 454 };
434 455
435 () # make sure we don't leak the watcher 456 () # 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} 457}
452 458
453# fork template from current process, used by AnyEvent::Fork::Early/Template 459# fork template from current process, used by AnyEvent::Fork::Early/Template
454sub _new_fork { 460sub _new_fork {
455 my ($fh, $slave) = AnyEvent::Util::portable_socketpair; 461 my ($fh, $slave) = AnyEvent::Util::portable_socketpair;
… …
460 if ($pid eq 0) { 466 if ($pid eq 0) {
461 require AnyEvent::Fork::Serve; 467 require AnyEvent::Fork::Serve;
462 $AnyEvent::Fork::Serve::OWNER = $parent; 468 $AnyEvent::Fork::Serve::OWNER = $parent;
463 close $fh; 469 close $fh;
464 $0 = "$_[1] of $parent"; 470 $0 = "$_[1] of $parent";
465 $SIG{CHLD} = 'IGNORE';
466 AnyEvent::Fork::Serve::serve ($slave); 471 AnyEvent::Fork::Serve::serve ($slave);
467 exit 0; 472 exit 0;
468 } elsif (!$pid) { 473 } elsif (!$pid) {
469 die "AnyEvent::Fork::Early/Template: unable to fork template process: $!"; 474 die "AnyEvent::Fork::Early/Template: unable to fork template process: $!";
470 } 475 }
… …
589AnyEvent::Fork itself. 594AnyEvent::Fork itself.
590 595
591=cut 596=cut
592 597
593sub pid { 598sub pid {
594 $_[0][0] 599 $_[0][PID]
595} 600}
596 601
597=item $proc = $proc->eval ($perlcode, @args) 602=item $proc = $proc->eval ($perlcode, @args)
598 603
599Evaluates the given C<$perlcode> as ... perl code, while setting C<@_> to 604Evaluates the given C<$perlcode> as ... Perl code, while setting C<@_> to
600the strings specified by C<@args>, in the "main" package. 605the strings specified by C<@args>, in the "main" package.
601 606
602This call is meant to do any custom initialisation that might be required 607This 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 608(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. 609to completely take over the process, use C<run> for that.
… …
666sub send_fh { 671sub send_fh {
667 my ($self, @fh) = @_; 672 my ($self, @fh) = @_;
668 673
669 for my $fh (@fh) { 674 for my $fh (@fh) {
670 $self->_cmd ("h"); 675 $self->_cmd ("h");
671 push @{ $self->[2] }, \$fh; 676 push @{ $self->[QUEUE] }, \$fh;
672 } 677 }
673 678
674 $self 679 $self
675} 680}
676 681
… …
762=cut 767=cut
763 768
764sub run { 769sub run {
765 my ($self, $func, $cb) = @_; 770 my ($self, $func, $cb) = @_;
766 771
767 $self->[4] = $cb; 772 $self->[CB] = $cb;
768 $self->_cmd (r => $func); 773 $self->_cmd (r => $func);
769} 774}
770 775
771=back 776=back
772 777
… …
800So how can C<< AnyEvent->new >> be faster than a standard fork, even 805So how can C<< AnyEvent->new >> be faster than a standard fork, even
801though it uses the same operations, but adds a lot of overhead? 806though it uses the same operations, but adds a lot of overhead?
802 807
803The difference is simply the process size: forking the 5MB process takes 808The difference is simply the process size: forking the 5MB process takes
804so much longer than forking the 2.5MB template process that the extra 809so much longer than forking the 2.5MB template process that the extra
805overhead introduced is canceled out. 810overhead is canceled out.
806 811
807If the benchmark process grows, the normal fork becomes even slower: 812If the benchmark process grows, the normal fork becomes even slower:
808 813
809 1340 new processes, manual fork of a 20MB process 814 1340 new processes, manual fork of a 20MB process
810 731 new processes, manual fork of a 200MB process 815 731 new processes, manual fork of a 200MB process
… …
870initialising them, for example, by calling C<init Gtk2> manually. 875initialising them, for example, by calling C<init Gtk2> manually.
871 876
872=item exiting calls object destructors 877=item exiting calls object destructors
873 878
874This only applies to users of L<AnyEvent::Fork:Early> and 879This only applies to users of L<AnyEvent::Fork:Early> and
875L<AnyEvent::Fork::Template>, or when initialiasing code creates objects 880L<AnyEvent::Fork::Template>, or when initialising code creates objects
876that reference external resources. 881that reference external resources.
877 882
878When a process created by AnyEvent::Fork exits, it might do so by calling 883When 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 884exit, or simply letting perl reach the end of the program. At which point
880Perl runs all destructors. 885Perl runs all destructors.
… …
905Cygwin perl is not supported at the moment due to some hilarious 910Cygwin perl is not supported at the moment due to some hilarious
906shortcomings of its API - see L<IO::FDPoll> for more details. 911shortcomings of its API - see L<IO::FDPoll> for more details.
907 912
908=head1 SEE ALSO 913=head1 SEE ALSO
909 914
910L<AnyEvent::Fork::Early> (to avoid executing a perl interpreter), 915L<AnyEvent::Fork::Early>, to avoid executing a perl interpreter at all
916(part of this distribution).
917
911L<AnyEvent::Fork::Template> (to create a process by forking the main 918L<AnyEvent::Fork::Template>, to create a process by forking the main
912program at a convenient time). 919program at a convenient time (part of this distribution).
913 920
914=head1 AUTHOR 921L<AnyEvent::Fork::RPC>, for simple RPC to child processes (on CPAN).
922
923=head1 AUTHOR AND CONTACT INFORMATION
915 924
916 Marc Lehmann <schmorp@schmorp.de> 925 Marc Lehmann <schmorp@schmorp.de>
917 http://home.schmorp.de/ 926 http://software.schmorp.de/pkg/AnyEvent-Fork
918 927
919=cut 928=cut
920 929
9211 9301
922 931

Diff Legend

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