--- AnyEvent-Fork/Fork.pm 2013/04/02 18:00:04 1.3 +++ AnyEvent-Fork/Fork.pm 2013/04/03 07:35:57 1.4 @@ -1,25 +1,22 @@ =head1 NAME -AnyEvent::ProcessPool - manage pools of perl worker processes, exec'ed or fork'ed +AnyEvent::Fork - everything you wanted to use fork() for, but couldn't =head1 SYNOPSIS - use AnyEvent::ProcessPool; + use AnyEvent::Fork; =head1 DESCRIPTION -This module allows you to create single worker processes but also worker -pool that share memory, by forking from the main program, or exec'ing new -perl interpreters from a module. - -You create a new processes in a pool by specifying a function to call -with any combination of string values and file handles. - -A pool can have initialisation code which is executed before forking. The -initialisation code is only executed once and the resulting process is -cached, to be used as a template. - -Pools without such initialisation code don't cache an extra process. +This module allows you to create new processes, without actually forking +them from your current process (avoiding the problems of forking), but +preserving most of the advantages of fork. + +It can be used to create new worker processes or new independent +subprocesses for short- and long-running jobs, process pools (e.g. for use +in pre-forked servers) but also to spawn new external processes (such as +CGI scripts from a webserver), which can be faster (and more well behaved) +than using fork+exec in big processes. =head1 PROBLEM STATEMENT @@ -147,22 +144,19 @@ =cut -package AnyEvent::ProcessPool; +package AnyEvent::Fork; use common::sense; use Socket (); -use Proc::FastSpawn; use AnyEvent; -use AnyEvent::ProcessPool::Util; +use AnyEvent::Fork::Util; use AnyEvent::Util (); -BEGIN { -# require Exporter; -} +our $PERL; # the path to the perl interpreter, deduces with various forms of magic -=item my $pool = new AnyEvent::ProcessPool key => value... +=item my $pool = new AnyEvent::Fork key => value... Create a new process pool. The following named parameters are supported: @@ -172,82 +166,237 @@ =cut -# the template process -our $template; +# the empty template process +our $TEMPLATE; + +sub _cmd { + my $self = shift; + + # ideally, we would want to use "a (w/a)*" as format string, but perl versions + # form at least 5.8.9 to 5.16.3 are all buggy and can't unpack it. + push @{ $self->[2] }, pack "N/a", pack "(w/a)*", @_; + + $self->[3] ||= AE::io $self->[1], 1, sub { + if (ref $self->[2][0]) { + AnyEvent::Fork::Util::fd_send fileno $self->[1], fileno ${ $self->[2][0] } + and shift @{ $self->[2] }; + } else { + my $len = syswrite $self->[1], $self->[2][0] + or do { undef $self->[3]; die "AnyEvent::Fork: command write failure: $!" }; + substr $self->[2][0], 0, $len, ""; + shift @{ $self->[2] } unless length $self->[2][0]; + } + + unless (@{ $self->[2] }) { + undef $self->[3]; + $self->[0]->($self->[1]) if $self->[0]; + } + }; +} -sub _queue { - my ($pid, $fh) = @_; +sub _new { + my ($self, $fh) = @_; - [ - $pid, + $self = bless [ + undef, # run callback $fh, - [], - undef - ] + [], # write queue - strings or fd's + undef, # AE watcher + ], $self; + +# my ($a, $b) = AnyEvent::Util::portable_socketpair; + +# queue_cmd $template, "Iabc"; +# push @{ $template->[2] }, \$b; + +# use Coro::AnyEvent; Coro::AnyEvent::sleep 1; +# undef $b; +# die "x" . <$a>; + + $self } -sub queue_cmd { - my $queue = shift; +=item my $proc = new AnyEvent::Fork - push @{ $queue->[2] }, pack "N/a", pack "a (w/a)*", @_; +Create a new "empty" perl interpreter process and returns its process +object for further manipulation. - $queue->[3] ||= AE::io $queue->[1], 1, sub { - if (ref $queue->[2][0]) { - AnyEvent::ProcessPool::Util::fd_send fileno $queue->[1], fileno ${ $queue->[2][0] } - and shift @{ $queue->[2] }; - } else { - my $len = syswrite $queue->[1], $queue->[2][0] - or do { undef $queue->[3]; die "AnyEvent::ProcessPool::queue write failure: $!" }; - substr $queue->[2][0], 0, $len, ""; - shift @{ $queue->[2] } unless length $queue->[2][0]; - } +The new process is forked from a template process that is kept around +for this purpose. When it doesn't exist yet, it is created by a call to +C and kept around for future calls. - undef $queue->[3] unless @{ $queue->[2] }; - }; +=cut + +sub new { + my $class = shift; + + $TEMPLATE ||= $class->new_exec; + $TEMPLATE->fork } -sub run_template { - return if $template; +=item $new_proc = $proc->fork + +Forks C<$proc>, creating a new process, and returns the process object +of the new process. + +If any of the C functions have been called before fork, then they +will be cloned in the child. For example, in a pre-forked server, you +might C the listening socket into the template process, and then +keep calling C and C. + +=cut + +sub fork { + my ($self) = @_; my ($fh, $slave) = AnyEvent::Util::portable_socketpair; + + $self->send_fh ($slave); + $self->_cmd ("f"); + AnyEvent::Util::fh_nonblocking $fh, 1; - fd_inherit fileno $slave; + AnyEvent::Fork->_new ($fh) +} + +=item my $proc = new_exec AnyEvent::Fork + +Create a new "empty" perl interpreter process and returns its process +object for further manipulation. + +Unlike the C method, this method I spawns a new perl process +(except in some cases, see L for details). This +reduces the amount of memory sharing that is possible, and is also slower. + +You should use C whenever possible, except when having a template +process around is unacceptable. + +The path to the perl interpreter is divined usign various methods - first +C<$^X> is investigated to see if the path ends with something that sounds +as if it were the perl interpreter. Failing this, the module falls back to +using C<$Config::Config{perlpath}>. + +=cut + +sub new_exec { + my ($self) = @_; + + # first find path of perl + my $perl = $; + + # first we try $^X, but the path must be absolute (always on win32), and end in sth. + # that looks like perl. this obviously only works for posix and win32 + unless ( + (AnyEvent::Fork::Util::WIN32 || $perl =~ m%^/%) + && $perl =~ m%[/\\]perl(?:[0-9]+(\.[0-9]+)+)?(\.exe)?$%i + ) { + # if it doesn't look perlish enough, try Config + require Config; + $perl = $Config::Config{perlpath}; + $perl =~ s/(?:\Q$Config::Config{_exe}\E)?$/$Config::Config{_exe}/; + } + + require Proc::FastSpawn; + + my ($fh, $slave) = AnyEvent::Util::portable_socketpair; + AnyEvent::Util::fh_nonblocking $fh, 1; + Proc::FastSpawn::fd_inherit (fileno $slave); + + # quick. also doesn't work in win32. of course. what did you expect + #local $ENV{PERL5LIB} = join ":", grep !ref, @INC; my %env = %ENV; $env{PERL5LIB} = join ":", grep !ref, @INC; - my $pid = spawn - $^X, - ["perl", "-MAnyEvent::ProcessPool::Serve", "-e", "AnyEvent::ProcessPool::Serve::me", fileno $slave], - [map "$_=$env{$_}", keys %env], - or die "unable to spawn AnyEvent::ProcessPool server: $!"; + Proc::FastSpawn::spawn ( + $perl, + ["perl", "-MAnyEvent::Fork::Serve", "-e", "AnyEvent::Fork::Serve::me", fileno $slave], + [map "$_=$env{$_}", keys %env], + ) or die "unable to spawn AnyEvent::Fork server: $!"; + + $self->_new ($fh) +} + +=item $proc = $proc->require ($module, ...) - close $slave; +Tries to load the given modules into the process - $template = _queue $pid, $fh; +Returns the process object for easy chaining of method calls. - my ($a, $b) = AnyEvent::Util::portable_socketpair; +=item $proc = $proc->send_fh ($handle, ...) - queue_cmd $template, "Iabc"; - push @{ $template->[2] }, \$b; +Send one or more file handles (I file descriptors) to the process, +to prepare a call to C. - use Coro::AnyEvent; Coro::AnyEvent::sleep 1; - undef $b; - die "x" . <$a>; +The process object keeps a reference to the handles until this is done, +so you must not explicitly close the handles. This is most easily +accomplished by simply not storing the file handles anywhere after passing +them to this method. + +Returns the process object for easy chaining of method calls. + +=cut + +sub send_fh { + my ($self, @fh) = @_; + + for my $fh (@fh) { + $self->_cmd ("h"); + push @{ $self->[2] }, \$fh; + } + + $self } -sub new { - my $class = shift; +=item $proc = $proc->send_arg ($string, ...) + +Send one or more argument strings to the process, to prepare a call to +C. The strings can be any octet string. + +Returns the process object for easy chaining of emthod calls. + +=cut - my $self = bless { - @_ - }, $class; +sub send_arg { + my ($self, @arg) = @_; - run_template; + $self->_cmd (a => @arg); $self } +=item $proc->run ($func, $cb->($fh)) + +Enter the function specified by the fully qualified name in C<$func> in +the process. The function is called with the communication socket as first +argument, followed by all file handles and string arguments sent earlier +via C and C methods, in the order they were called. + +If the called function returns, the process exits. + +Preparing the process can take time - when the process is ready, the +callback is invoked with the local communications socket as argument. + +The process object becomes unusable on return from this function. + +If the communication socket isn't used, it should be closed on both sides, +to save on kernel memory. + +The socket is non-blocking in the parent, and blocking in the newly +created process. The close-on-exec flag is set on both. Even if not used +otherwise, the socket can be a good indicator for the existance of the +process - if the othe rprocess exits, you get a readable event on it, +because exiting the process closes the socket (if it didn't create any +children using fork). + +=cut + +sub run { + my ($self, $func, $cb) = @_; + + $self->[0] = $cb; + $self->_cmd ("r", $func); +} + =back =head1 AUTHOR