use 5;        # ??? more specific.
use strict;
use warnings;


# ----------------------------------------


use IO::Handle ();
use Socket     ();


# ----------------------------------------


package Win32::SelectablePipe;

BEGIN { our $VERSION = '0.9'; }


# ---

BEGIN {
   require Exporter;
   our @EXPORT    = ();
   our @EXPORT_OK = qw( selectable_pipe );
   *import = \&Exporter::import;
}


# ---


sub POSIX_FIONBIO () { (0x80000000 | (4<<16) | (ord('f')<<8) | 126) } # 0x8004667E
sub POSIX_EAGAIN  () { 10035 }
sub POSIX_EISCONN () { 10056 }


# ---


sub _croak {
   require Carp;
   my $calling_func = (caller(1))[3];
   my $text = join('', @_);
   $text =~ s/\\!/
   
      ~~~

   /e;
   $text =~ s/\\!/'['.(0+$!).'] '.$!/e;
   Carp::croak("$calling_func: $text");
}

sub _carp {
   require Carp;
   local $" = '';
   my $calling_func = (caller(1))[3];
   Carp::carp("$calling_func: @_");
}


# ---


sub selectable_pipe {
   scalar(@_) == 0 || scalar(@_) == 2
   or _croak("Bad number of arguments");
   
   $_[0] = IO::Handle::gensym() unless (defined($_[0]));
   $_[1] = IO::Handle::gensym() unless (defined($_[1]));

   my ($one, $two)= @_;


   # If either handle is passed as a string, place
   # add to it the caller's package if no package
   # is specified, and convert it to a reference.

   {
      my $pkg_name = caller();
      my $handle;
      foreach $handle ($one, $two) {
         unless (ref($handle) || ref(\$handle) eq 'GLOB') {
            $handle = caller().'::'.$handle unless ($handle =~ /::/);
            { no strict 'refs'; $handle = *$handle; }
         }
      }
   }


   my $server = IO::Handle::gensym();


   # Initialize some constants.

   my $tcp = getprotobyname('tcp');

   my $localhost = gethostbyname('localhost')
   or _croak("Can't find localhost: \\!");

   my $addr = Socket::sockaddr_in(0, $localhost)
   or _croak("Can't build localhost address: \\!");  # Impossible error?


   # Create a server socket.

   socket($server, &Socket::PF_INET, &Socket::SOCK_STREAM, $tcp)
   or _croak("Can't create TCP socket ($server): \\!");

   bind($server, $addr)
   or _croak("Can't bind socket ($server) to localhost address: \\!");

   my $server_addr = getsockname($server)
   or _croak("Can't get socket ($server) address: \\!");

   listen($server, 1)
   or _croak("Can't listen on socket ($server): \\!");


   # Connect to the server with one of our "pipe ends".

   socket($two, &Socket::PF_INET, &Socket::SOCK_STREAM, $tcp)
   or _croak("Can't create TCP socket ($server): \\!");

   connect($two, $server_addr)
   or _croak("Can't connect: \\!");


   # Accept the other "pipe end" from the server.

   accept($one, $server)
   or _croak("Can't accept: \\!");


   # sleep(1);

   close($server);

   return ($one, $two);
}


sub selectable_pipe_nbc {
   scalar(@_) == 0 || scalar(@_) == 2
   or _croak("Bad number of arguments");
   
   $_[0] = IO::Handle::gensym() unless (defined($_[0]));
   $_[1] = IO::Handle::gensym() unless (defined($_[1]));

   my ($one, $two)= @_;


   # If either handle is passed as a string, place
   # add to it the caller's package if no package
   # is specified, and convert it to a reference.

   {
      my $pkg_name = caller();
      my $handle;
      foreach $handle ($one, $two) {
         unless (ref($handle) || ref(\$handle) eq 'GLOB') {
            $handle = caller().'::'.$handle unless ($handle =~ /::/);
            { no strict 'refs'; $handle = *$handle; }
         }
      }
   }


   my $server = IO::Handle::gensym();


   # Initialize some constants.

   my $tcp = getprotobyname('tcp');

   my $localhost = gethostbyname('localhost')
   or _croak("Can't find localhost: \\!");

   my $addr = Socket::sockaddr_in(0, $localhost)
   or _croak("Can't build localhost address: \\!");  # Impossible error?


   # Create a server socket.

   socket($server, &Socket::PF_INET, &Socket::SOCK_STREAM, $tcp)
   or _croak("Can't create TCP socket ($server): \\!");

   bind($server, $addr)
   or _croak("Can't bind socket ($server) to localhost address: \\!");

   my $server_addr = getsockname($server)
   or _croak("Can't get socket ($server) address: \\!");

   listen($server, 1)
   or _croak("Can't listen on socket ($server): \\!");


   # Make $two non-blocking before we connect to the server
   # so we can accept the connection from the server socket.
   # This requires temporarily making $two a server socket.

   socket($two, &Socket::PF_INET, &Socket::SOCK_STREAM, $tcp)
   or _croak("Can't create TCP socket ($server): \\!");

   bind($two, $addr)
   or _croak("Can't bind socket ($server) to localhost address: \\!");

   {
      ioctl($two, POSIX_FIONBIO, pack("I", 1))
      or $! == 0  # **
      or _croak("Can't ioctl socket ($two) to non-blocking: \\!");

      # ** - ioctl is returning undef,
      #      yet both $! and $^E are 0.
      #      I don't know what this means.
   }


   # Initiate connect.

   if (connect($two, $server_addr)) {
      # We didn't accept() yet, so:
      _carp("Strange, connect() succeeded?");
   } else {
      $! == POSIX_EAGAIN
      or _croak("Can't non-blockingly connect: \\!");
   }


   # Accept connect.

   accept($one, $server)
   or _croak("Can't accept: \\!");


   # Ensure we got connected.

   sleep(1);

   connect($two, $server_addr)
   or $! == POSIX_EISCONN
   _croak("Can't connect: \\!");


   close($server);

   return ($one, $two);
}


# ----------------------------------------


1;


__END__

* Requires TCP/IP to be installed.

* The original version, selectable_pipe_nbc, uses a non-blocking connect.
  This doesn't seem to be needed. selectable_pipe does not use a non-blocking connect.

* Sometimes, the error message can only be displayed by $^E (and sometimes, only by $!).
  If $! gives an 'unknown error' for a given error number, $^E has the error message.

* Security considerations.
  TODO?: Check source and destinatin addresses.



      my $err_msg = "$!";
      my $win_err_msg = "$^E";
      defined($win_err_msg) && length($win_err_msg)
      '['.(0+$^E).'] '.$^E
      '['.(0+$!).'] '.$!