my ($r, $w);
if (AnyEvent::WIN32) {
socketpair $r, $w, &Socket::AF_UNIX, &Socket::SOCK_STREAM, 0
or return;
} else {
pipe $r, $w
or return;
}
($r, $w)
}
=item fork_call $coderef, @args, $cb->(@res)
Executes the given code reference asynchronously, by forking. Everything
the C<$coderef> returns will transferred to the calling process (by
serialising and deserialising via L<Storable>).
If there are any errors, then the C<$cb> will be called without any
arguments. In that case, either C<$@> contains the exception, or C<$!>
contains an error number. In all other cases, C<$@> will be C<undef>ined.
The C<$coderef> must not ever call an event-polling function or use
event-based programming.
Note that forking can be expensive in large programs (RSS 200MB+). On
windows, it is abysmally slow, do not expect more than 5..20 forks/s on
that sucky platform (note this uses perl's pseudo-threads, so avoid those
like the plague).
=item $AnyEvent::Util::MAX_FORKS [default: 10]
The maximum number of child processes that C<fork_call> will fork in
parallel. Any additional requests will be queued until a slot becomes free
again.
The environment variable C<PERL_ANYEVENT_MAX_FORKS> is used to initialise
this value.
=cut
our $MAX_FORKS = int 1 * $ENV{PERL_ANYEVENT_MAX_FORKS};
$MAX_FORKS = 10 if $MAX_FORKS <= 0;
my $forks;
my @fork_queue;
sub _fork_schedule;
sub _fork_schedule {
while () {
return if $forks >= $MAX_FORKS;
my $job = shift @fork_queue
or return;
++$forks;
my $coderef = shift @$job;
my $cb = pop @$job;
# gimme a break...
my ($r, $w) = portable_pipe
or ($forks and last) # allow failures when we have at least one job
or die "fork_call: $!";
my $pid = fork;
if ($pid != 0) {
# parent
close $w;
my $buf;
my $ww; $ww = AnyEvent->io (fh => $r, poll => 'r', cb => sub {
my $len = sysread $r, $buf, 65536, length $buf;
if ($len <= 0) {
undef $ww;
close $r;
--$forks;
_fork_schedule;
my $result = eval { Storable::thaw ($buf) };
$result = [$@] unless $result;
$@ = shift @$result;
$cb->(@$result);
# clean up the pid
waitpid $pid, 0;
}
});
} elsif (defined $pid) {
# child
close $r;
my $result = eval {
local $SIG{__DIE__};
=2= |