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