view release on metacpan or  search on metacpan

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

   ) {
      *AF_INET6 = \&_AF_INET6;
   } else {
      # disable ipv6
      *AF_INET6 = sub () { 0 };
      delete $AnyEvent::PROTOCOL{ipv6};
   }

   # fix buggy Errno on some non-POSIX platforms
   # such as openbsd and windows.
   my %ERR = (
      EBADMSG => Errno::EDOM   (),
      EPROTO  => Errno::ESPIPE (),
   );

   while (my ($k, $v) = each %ERR) {
      next if eval "Errno::$k ()";
      AE::log 8 => "Broken Errno module, adding Errno::$k.";

      eval "sub Errno::$k () { $v }";
      push @Errno::EXPORT_OK, $k;
      push @{ $Errno::EXPORT_TAGS{POSIX} }, $k;
   }
}

=item ($r, $w) = portable_pipe

Calling C<pipe> in Perl is portable - except it doesn't really work on
sucky windows platforms (at least not with most perls - cygwin's perl
notably works fine): On windows, you actually get two file handles you
cannot use select on.

This function gives you a pipe that actually works even on the broken
windows platform (by creating a pair of TCP sockets on windows, so do not
expect any speed from that) and using C<pipe> everywhere else.

See C<portable_socketpair>, below, for a bidirectional "pipe".

Returns the empty list on any errors.

=item ($fh1, $fh2) = portable_socketpair

Just like C<portable_pipe>, above, but returns a bidirectional pipe
(usually by calling C<socketpair> to create a local loopback socket pair,
except on windows, where it again returns two interconnected TCP sockets).

Returns the empty list on any errors.

=cut

BEGIN {
   if (AnyEvent::WIN32) {
      *_win32_socketpair = sub () {
         # perl's socketpair emulation fails on many vista machines, because
         # vista returns fantasy port numbers.

         for (1..10) {
            socket my $l, Socket::AF_INET(), Socket::SOCK_STREAM(), 0
               or next;

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

            my $sa = getsockname $l
               or next;

            listen $l, 1
               or next;

            socket my $r, Socket::AF_INET(), Socket::SOCK_STREAM(), 0
               or next;

            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