view release on metacpan or  search on metacpan

lib/AnyEvent/Util.pm  view on Meta::CPAN

            bind $r, Socket::pack_sockaddr_in 0, "\x7f\x00\x00\x01"
               or next;

            connect $r, $sa
               or next;

            accept my $w, $l
               or next;

            # vista has completely broken peername/sockname that return
            # fantasy ports. this combo seems to work, though.
            (Socket::unpack_sockaddr_in getpeername $r)[0]
            == (Socket::unpack_sockaddr_in getsockname $w)[0]
               or (($! = WSAEINVAL), next);

            # vista example (you can't make this shit up...):
            #(Socket::unpack_sockaddr_in getsockname $r)[0] == 53364
            #(Socket::unpack_sockaddr_in getpeername $r)[0] == 53363
            #(Socket::unpack_sockaddr_in getsockname $w)[0] == 53363
            #(Socket::unpack_sockaddr_in getpeername $w)[0] == 53365

            return ($r, $w);
         }

         ()
      };

      *portable_socketpair = \&_win32_socketpair;
      *portable_pipe       = \&_win32_socketpair;
   } else {
      *portable_pipe = sub () {
         my ($r, $w);

         pipe $r, $w
            or return;

         ($r, $w);
      };

      *portable_socketpair = sub () {
         socketpair my $fh1, my $fh2, Socket::AF_UNIX(), Socket::SOCK_STREAM(), 0
            or return;

         ($fh1, $fh2)
      };
   }
}

=item fork_call { CODE } @args, $cb->(@res)

Executes the given code block asynchronously, by forking. Everything the
block returns will be 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 (and C<$!> is
irrelevant), or C<$!> contains an error number. In all other cases, C<$@>
will be C<undef>ined.

The code block must not ever call an event-polling function or use
event-based programming that might cause any callbacks registered in the
parent to run.

Win32 spoilers: Due to the endlessly sucky and broken native windows
perls (there is no way to cleanly exit a child process on that platform
that doesn't also kill the parent), you have to make sure that your main
program doesn't exit as long as any C<fork_calls> are still in progress,
otherwise the program won't exit. Also, on most windows platforms some
memory will leak for every invocation. We are open for improvements that
don't require XS hackery.

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).

Example: poor man's async disk I/O (better use L<AnyEvent::IO> together
with L<IO::AIO>).

   fork_call {
      open my $fh, "</etc/passwd"
         or die "passwd: $!";
      local $/;
      <$fh>
   } sub {
      my ($passwd) = @_;
      ...
   };

=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 {
   require Storable unless $Storable::VERSION;
   require POSIX    unless $POSIX::VERSION;

   while ($forks < $MAX_FORKS) {
      my $job = shift @fork_queue
         or last;

      ++$forks;

      my $coderef = shift @$job;
      my $cb = pop @$job;
      
      # gimme a break...