Skip Menu |
 

This queue is for tickets about the IO-Socket-IP CPAN distribution.

Report information
The Basics
Id: 77726
Status: resolved
Priority: 0/
Queue: IO-Socket-IP

People
Owner: Nobody in particular
Requestors: sri [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: 0.12



Subject: Non-blocking IO::Socket::IP does not connect on instantiation
Download (untitled) / with headers
text/plain 500b
It would be nice if the instantiation behavior of IO::Socket::IP was a little closer to that of IO::Socket::INET when used non-blocking. Currently there's an explicit call to ->connect required before the handle can be passed to IO::Poll and friends. perl -MIO::Socket::IP -E 'say IO::Socket::IP->new(Blocking => 0, PeerAddr => "mojolicio.us", PeerPort => 80)->fileno' vs perl -MIO::Socket::INET -E 'say IO::Socket::INET->new(Blocking => 0, PeerAddr => "mojolicio.us", PeerPort => 80)->fileno'
Download (untitled) / with headers
text/plain 374b
On Fri Jun 08 19:14:00 2012, SRI wrote: Show quoted text
> perl -MIO::Socket::IP -E 'say IO::Socket::IP->new(Blocking => 0, > PeerAddr => "mojolicio.us", > PeerPort => 80)->fileno'
The attached patch should fix this. $ $ perl -Mblib -MIO::Socket::IP -E 'say IO::Socket::IP->new(Blocking => 0, PeerAddr => "mojolicio.us", PeerPort => 80)->fileno' 3 Will be in 0.12. -- Paul Evans
Subject: rt77726.patch
Download rt77726.patch
text/x-diff 2.8k
=== modified file 'lib/IO/Socket/IP.pm' --- lib/IO/Socket/IP.pm 2012-06-01 15:49:20 +0000 +++ lib/IO/Socket/IP.pm 2012-06-14 11:24:40 +0000 @@ -520,9 +520,9 @@ ${*$self}{io_socket_ip_errors} = [ undef, undef, undef ]; - if( $blocking ) { - $self->setup or return undef; - } + # ->setup is allowed to return false in nonblocking mode + $self->setup or !$blocking or return undef; + return $self; } @@ -594,11 +594,15 @@ return CORE::connect( $self, $_[0] ) if @_; - $! = 0, return 1 if $self->fileno and defined $self->peername; - if( $self->fileno ) { - # A connect has just failed, get its error value - ${*$self}{io_socket_ip_errors}[0] = $self->getsockopt( SOL_SOCKET, SO_ERROR ); + # A connect call may have just finished. It succeeded if we have a peername + $! = 0, return 1 if defined $self->peername; + + # If not, it may have just failed. Get its error value + my $errno = ${*$self}{io_socket_ip_errors}[0] = $self->getsockopt( SOL_SOCKET, SO_ERROR ); + + # If errno is 0 then it hasn't failed yet, so keep polling + $! = EINPROGRESS, return 0 if !$errno; } return $self->setup; === modified file 't/20nonblocking-connect.t' --- t/20nonblocking-connect.t 2011-10-17 13:45:03 +0000 +++ t/20nonblocking-connect.t 2012-06-14 11:24:40 +0000 @@ -1,7 +1,7 @@ #!/usr/bin/perl -w use strict; -use Test::More tests => 8; +use Test::More tests => 9; use IO::Socket::IP; @@ -24,6 +24,8 @@ ok( defined $socket, 'IO::Socket::IP->new( Blocking => 0 ) constructs a socket' ) or diag( " error was $@" ); +ok( defined $socket->fileno, '$socket has a fileno immediately after construction' ); + while( !$socket->connect and ( $! == EINPROGRESS || $! == EWOULDBLOCK ) ) { my $wvec = ''; vec( $wvec, fileno $socket, 1 ) = 1; === modified file 't/21nonblocking-connect-internet.t' --- t/21nonblocking-connect-internet.t 2011-10-17 13:45:03 +0000 +++ t/21nonblocking-connect-internet.t 2012-06-14 11:24:40 +0000 @@ -1,7 +1,7 @@ #!/usr/bin/perl -w use strict; -use Test::More tests => 10; +use Test::More tests => 12; use IO::Socket::IP; @@ -30,6 +30,8 @@ ok( defined $socket, "defined \$socket for $test_host:$test_good_port" ) or diag( " error was $@" ); + ok( defined $socket->fileno, '$socket has fileno' ); + # This and test is required to placate a warning IO::Socket would otherwise # throw; https://rt.cpan.org/Ticket/Display.html?id=63052 ok( not( $socket->opened and $socket->connected ), '$socket not yet connected' ); @@ -72,6 +74,8 @@ ok( defined $socket, "defined \$socket for $test_host:$test_bad_port" ) or diag( " error was $@" ); + ok( defined $socket->fileno, '$socket has fileno' ); + ok( not( $socket->opened and $socket->connected ), '$socket not yet connected' ); my $selectcount = 0;
Now released as 0.12. -- Paul Evans


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.