1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
# 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 -- leonerd@leonerd.org.uk
package IO::Async::OS::MSWin32;
use strict;
use warnings;
our $VERSION = '0.51';
our @ISA = qw( IO::Async::OS::_Base );
use Carp;
use Socket qw( AF_INET SOCK_STREAM SOCK_DGRAM );
use IO::Socket (); # empty import
use constant HAVE_FAKE_ISREG_READY => 1;
use constant HAVE_SELECT_CONNECT_EVEC => 1;
use constant HAVE_CONNECT_EWOULDBLOCK => 1;
use constant HAVE_RENAME_OPEN_FILES => 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 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;
if( $socktype == SOCK_STREAM ) {
my $listener = IO::Socket::INET->new(
LocalAddr => "127.0.0.1",
LocalPort => 0,
Listen => 1,
Blocking => 0,
) or croak "Cannot socket() - $!";
my $S1 = IO::Socket::INET->new(
PeerAddr => $listener->sockhost,
PeerPort => $listener->sockport
) or croak "Cannot socket() again - $!";
my $S2 = $listener->accept or croak "Cannot accept() - $!";
$listener->close;
return ( $S1, $S2 );
}
elsif( $socktype == SOCK_DGRAM ) {
my $S1 = IO::Socket::INET->new(
LocalAddr => "127.0.0.1",
Type => SOCK_DGRAM,
Proto => "udp",
) or croak "Cannot socket() - $!";
my $S2 = IO::Socket::INET->new(
LocalAddr => "127.0.0.1",
Type => SOCK_DGRAM,
Proto => "udp",
) or croak "Cannot socket() again - $!";
$S1->connect( $S2->sockname );
$S2->connect( $S1->sockname );
return ( $S1, $S2 );
}
else {
croak "Unrecognised socktype $socktype";
}
};
=head1 AUTHOR
Paul Evans <leonerd@leonerd.org.uk>
=cut
0x55AA;
|
