1# You may distribute under the terms of either the GNU General Public License 2# or the Artistic License (the same terms as Perl itself) 3# 4# (C) Paul Evans, 2012-2013 -- leonerd@leonerd.org.uk 5 6package IO::Async::OS::MSWin32; 7 8use strict; 9use warnings; 10 11our $VERSION = '0.800'; 12 13our @ISA = qw( IO::Async::OS::_Base ); 14 15use Carp; 16 17use Socket qw( AF_INET SOCK_STREAM SOCK_DGRAM INADDR_LOOPBACK pack_sockaddr_in ); 18 19use IO::Socket (); # empty import 20 21use constant HAVE_FAKE_ISREG_READY => 1; 22 23# Also select() only reports connect() failures by evec, not wvec 24use constant HAVE_SELECT_CONNECT_EVEC => 1; 25 26use constant HAVE_POLL_CONNECT_POLLPRI => 1; 27 28use constant HAVE_CONNECT_EWOULDBLOCK => 1; 29 30use constant HAVE_RENAME_OPEN_FILES => 0; 31 32# poll(2) on Windows is emulated by wrapping select(2) anyway, so we might as 33# well try the Select loop first 34use constant LOOP_BUILTIN_CLASSES => qw( Select Poll ); 35 36# CORE::fork() does not provide full POSIX semantics 37use constant HAVE_POSIX_FORK => 0; 38 39# Windows does not have signals, and SIGCHLD is not available 40use constant HAVE_SIGNALS => 0; 41 42=head1 NAME 43 44C<IO::Async::OS::MSWin32> - operating system abstractions on C<MSWin32> for C<IO::Async> 45 46=head1 DESCRIPTION 47 48This module contains OS support code for C<MSWin32>. 49 50See instead L<IO::Async::OS>. 51 52=cut 53 54# Win32's pipes don't actually work with select(). We'll have to create 55# sockets instead 56sub pipepair 57{ 58 shift->socketpair( 'inet', 'stream' ); 59} 60 61# Win32 doesn't have a socketpair(). We'll fake one up 62sub socketpair 63{ 64 my $self = shift; 65 my ( $family, $socktype, $proto ) = @_; 66 67 $family = $self->getfamilybyname( $family ) || AF_INET; 68 69 # SOCK_STREAM is the most likely 70 $socktype = $self->getsocktypebyname( $socktype ) || SOCK_STREAM; 71 72 $proto ||= 0; 73 74 $family == AF_INET or croak "Cannot emulate ->socketpair except on AF_INET"; 75 76 my $Stmp = $self->socket( $family, $socktype ) or return; 77 $Stmp->bind( pack_sockaddr_in( 0, INADDR_LOOPBACK ) ) or return; 78 79 my $S1 = $self->socket( $family, $socktype ) or return; 80 81 my $S2; 82 if( $socktype == SOCK_STREAM ) { 83 $Stmp->listen( 1 ) or return; 84 $S1->connect( getsockname $Stmp ) or return; 85 $S2 = $Stmp->accept or return; 86 87 # There's a bug in IO::Socket here, in that $S2 's ->socktype won't 88 # yet be set. We can apply a horribly hacky fix here 89 # defined $S2->socktype and $S2->socktype == $socktype or 90 # ${*$S2}{io_socket_type} = $socktype; 91 # But for now we'll skip the test for it instead 92 } 93 elsif( $socktype == SOCK_DGRAM ) { 94 $S2 = $Stmp; 95 $S1->connect( getsockname $S2 ) or return; 96 $S2->connect( getsockname $S1 ) or return; 97 } 98 else { 99 croak "Unrecognised socktype $socktype"; 100 } 101 102 return ( $S1, $S2 ); 103}; 104 105=head1 AUTHOR 106 107Paul Evans <leonerd@leonerd.org.uk> 108 109=cut 110 1110x55AA; 112