IO-Async-0.67HEADIO-Async-0.67master

3 files changed, 210 insertions, 0 deletions

diff --git a/lib/IO/Async/OS/MSWin32.pm b/lib/IO/Async/OS/MSWin32.pm
new file mode 100644
index 0000000..bfed7f7
--- /dev/null
+++ b/lib/IO/Async/OS/MSWin32.pm
@@ -0,0 +1,111 @@
+#  You may distribute under the terms of either the GNU General Public License
+#  or the Artistic License (the same terms as Perl itself)
+#
+#  (C) Paul Evans, 2012-2013 -- leonerd@leonerd.org.uk
+
+package IO::Async::OS::MSWin32;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.67';
+
+our @ISA = qw( IO::Async::OS::_Base );
+
+use Carp;
+
+use Socket qw( AF_INET SOCK_STREAM SOCK_DGRAM INADDR_LOOPBACK pack_sockaddr_in );
+
+use IO::Socket (); # empty import
+
+use constant HAVE_FAKE_ISREG_READY => 1;
+
+# Also select() only reports connect() failures by evec, not wvec
+use constant HAVE_SELECT_CONNECT_EVEC => 1;
+
+use constant HAVE_POLL_CONNECT_POLLPRI => 1;
+
+use constant HAVE_CONNECT_EWOULDBLOCK => 1;
+
+use constant HAVE_RENAME_OPEN_FILES => 0;
+
+# poll(2) on Windows is emulated by wrapping select(2) anyway, so we might as
+# well try the Select loop first
+use constant LOOP_BUILTIN_CLASSES => qw( Select Poll );
+
+# CORE::fork() does not provide full POSIX semantics
+use constant HAVE_POSIX_FORK => 0;
+
+# Windows does not have signals, and SIGCHLD is not available
+use constant HAVE_SIGNALS => 0;
+
+=head1 NAME
+
+C<IO::Async::OS::MSWin32> - operating system abstractions on C<MSWin32> for C<IO::Async>
+
+=head1 DESCRIPTION
+
+This module contains OS support code for C<MSWin32>.
+
+See instead L<IO::Async::OS>.
+
+=cut
+
+# Win32's pipes don't actually work with select(). We'll have to create
+# sockets instead
+sub pipepair
+{
+   shift->socketpair( 'inet', 'stream' );
+}
+
+# Win32 doesn't have a socketpair(). We'll fake one up
+sub socketpair
+{
+   my $self = shift;
+   my ( $family, $socktype, $proto ) = @_;
+
+   $family = $self->getfamilybyname( $family ) || AF_INET;
+
+   # SOCK_STREAM is the most likely
+   $socktype = $self->getsocktypebyname( $socktype ) || SOCK_STREAM;
+
+   $proto ||= 0;
+
+   $family == AF_INET or croak "Cannot emulate ->socketpair except on AF_INET";
+
+   my $Stmp = $self->socket( $family, $socktype ) or return;
+   $Stmp->bind( pack_sockaddr_in( 0, INADDR_LOOPBACK ) ) or return;
+
+   my $S1 = $self->socket( $family, $socktype ) or return;
+
+   my $S2;
+   if( $socktype == SOCK_STREAM ) {
+      $Stmp->listen( 1 ) or return;
+      $S1->connect( getsockname $Stmp ) or return;
+      $S2 = $Stmp->accept or return;
+
+      # There's a bug in IO::Socket here, in that $S2 's ->socktype won't
+      # yet be set. We can apply a horribly hacky fix here
+      #   defined $S2->socktype and $S2->socktype == $socktype or
+      #     ${*$S2}{io_socket_type} = $socktype;
+      # But for now we'll skip the test for it instead
+   }
+   elsif( $socktype == SOCK_DGRAM ) {
+      $S2 = $Stmp;
+      $S1->connect( getsockname $S2 ) or return;
+      $S2->connect( getsockname $S1 ) or return;
+   }
+   else {
+      croak "Unrecognised socktype $socktype";
+   }
+
+   return ( $S1, $S2 );
+};
+
+=head1 AUTHOR
+
+Paul Evans <leonerd@leonerd.org.uk>
+
+=cut
+
+0x55AA;
diff --git a/lib/IO/Async/OS/cygwin.pm b/lib/IO/Async/OS/cygwin.pm
new file mode 100644
index 0000000..630bf9a
--- /dev/null
+++ b/lib/IO/Async/OS/cygwin.pm
@@ -0,0 +1,40 @@
+#  You may distribute under the terms of either the GNU General Public License
+#  or the Artistic License (the same terms as Perl itself)
+#
+#  (C) Paul Evans, 2013 -- leonerd@leonerd.org.uk
+
+package IO::Async::OS::cygwin;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.67';
+
+our @ISA = qw( IO::Async::OS::_Base );
+
+# Cygwin almost needs no hinting above the POSIX-like base, except that its
+# emulation of poll() isn't quite perfect. It needs POLLPRI
+use constant HAVE_POLL_CONNECT_POLLPRI => 1;
+
+# Also select() only reports connect() failures by evec, not wvec
+use constant HAVE_SELECT_CONNECT_EVEC => 1;
+
+=head1 NAME
+
+C<IO::Async::OS::cygwin> - operating system abstractions on C<cygwin> for C<IO::Async>
+
+=head1 DESCRIPTION
+
+This module contains OS support code for C<cygwin>.
+
+See instead L<IO::Async::OS>.
+
+=cut
+
+=head1 AUTHOR
+
+Paul Evans <leonerd@leonerd.org.uk>
+
+=cut
+
+0x55AA;
diff --git a/lib/IO/Async/OS/linux.pm b/lib/IO/Async/OS/linux.pm
new file mode 100644
index 0000000..c12949b
--- /dev/null
+++ b/lib/IO/Async/OS/linux.pm
@@ -0,0 +1,59 @@
+#  You may distribute under the terms of either the GNU General Public License
+#  or the Artistic License (the same terms as Perl itself)
+#
+#  (C) Paul Evans, 2014-2015 -- leonerd@leonerd.org.uk
+
+package IO::Async::OS::linux;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.67';
+
+our @ISA = qw( IO::Async::OS::_Base );
+
+=head1 NAME
+
+C<IO::Async::OS::linux> - operating system abstractions on C<Linux> for C<IO::Async>
+
+=head1 DESCRIPTION
+
+This module contains OS support code for C<Linux>.
+
+See instead L<IO::Async::OS>.
+
+=cut
+
+# Suggest either Epoll or Ppoll loops first if they are installed
+use constant LOOP_PREFER_CLASSES => qw( Epoll Ppoll );
+
+# Try to use /proc/pid/fd to get the list of actually-open file descriptors
+# for our process. Saves a bit of time when running with high ulimit -n /
+# fileno counts.
+sub potentially_open_fds
+{
+   my $class = shift;
+
+   opendir my $fd_path, "/proc/$$/fd" or do {
+      warn "Cannot open /proc/$$/fd, falling back to generic method - $!";
+      return $class->SUPER::potentially_open_fds
+   };
+
+   # Skip ., .., our directory handle itself and any other cruft
+   # except fileno() isn't available for the handle so we'll
+   # end up with that in the output anyway. As long as we're
+   # called just before the relevant close() loop, this
+   # should be harmless enough.
+   my @fd = map { m/^([0-9]+)$/ ? $1 : () } readdir $fd_path;
+   closedir $fd_path;
+
+   return @fd;
+}
+
+=head1 AUTHOR
+
+Paul Evans <leonerd@leonerd.org.uk>
+
+=cut
+
+0x55AA;