package Portable::NonBlock;
use strict;

use vars qw(@ISA @EXPORT @EXPORT_OK);
require Exporter;
use POSIX;
use Socket;
use Symbol;

@EXPORT    = qw();
@EXPORT_OK = qw(setnonblock FIONBIO EAGAIN);
@ISA       = qw(Exporter);

### Default ###
*setsocknonblock = sub {
  my $sock = shift;
  my $flags = fcntl($sock, F_GETFL, 0)
    or warn "Can't get the fcntl flags on socket: $!\n";
  fcntl($sock, F_SETFL, $flags | O_NONBLOCK)
    or warn "Can't fcntl socket to non-blocking: $!\n";
};

### Win32 ###
sub SO_OPENTYPE { 0x7008 }

if ($^O eq 'MSWin32') {
  *POSIX::FIONBIO = sub { 0x8004667E };      # Gleaned from VC++ winsock2.h (\x8004667E)
  *POSIX::EAGAIN  = sub { 10035; };          # Gleaned by forcing a non-blocking send

  # Total *HACK* to allow winsock connect() to work on non-blocking sockets
  # Culprit is in perl source /win32/win32sck.c function set_socktype. We undo
  # the result of this function. See MSDN support on overlapped I/O for background
  # info: http://support.microsoft.com/support/kb/articles/Q181/6/11.ASP
  my $sock = gensym();
  socket($sock, PF_INET, SOCK_STREAM, getprotobyname('tcp')) or
    print "PORTABLE::BEGIN ERROR - can't create socket\n";
  setsockopt($sock, SOL_SOCKET, SO_OPENTYPE, 0) or
    print "PORTABLE::BEGIN ERROR - Can't setsockopt to overlapped: $!\n";
  close $sock;

  # Can't fcntl in windows, so we ioctlsocket.
  my $truevalue = 1;
  *setsocknonblock = sub {
    my $sock = shift;
    ioctl($sock, POSIX::FIONBIO(), \$truevalue) or
      warn "Can't ioctl socket to non-blocking: $!\n";
  };
}