[rt.cpan.org #61577] try to populate socket info when not cached

The fixes are originally by Daniel Kahn Gillmor
<dkg@fifthhorseman.net>, but I've made other changes.

diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm
index 5d4b19e..9e6f769 100644 (file)
--- a/dist/IO/lib/IO/Socket.pm
+++ b/dist/IO/lib/IO/Socket.pm
@@ -351,18 +351,27 @@ sub timeout {
 sub sockdomain {
     @_ == 1 or croak 'usage: $sock->sockdomain()';
     my $sock = shift;
+    if (!defined(${*$sock}{'io_socket_domain'})) {
+       my $addr = $sock->sockname();
+       ${*$sock}{'io_socket_domain'} = sockaddr_family($addr)
+           if (defined($addr));
+    }
     ${*$sock}{'io_socket_domain'};
 }
 
 sub socktype {
     @_ == 1 or croak 'usage: $sock->socktype()';
     my $sock = shift;
+    ${*$sock}{'io_socket_type'} = $sock->sockopt(Socket::SO_TYPE)
+       if (!defined(${*$sock}{'io_socket_type'}) && defined(eval{Socket::SO_TYPE}));
     ${*$sock}{'io_socket_type'}
 }
 
 sub protocol {
     @_ == 1 or croak 'usage: $sock->protocol()';
     my($sock) = @_;
+    ${*$sock}{'io_socket_proto'} = $sock->sockopt(Socket::SO_PROTOCOL)
+       if (!defined(${*$sock}{'io_socket_proto'}) && defined(eval{Socket::SO_PROTOCOL}));
     ${*$sock}{'io_socket_proto'};
 }
 

diff --git a/dist/IO/t/cachepropagate-udp.t b/dist/IO/t/cachepropagate-udp.t
index de18eae..91cff37 100644 (file)
--- a/dist/IO/t/cachepropagate-udp.t
+++ b/dist/IO/t/cachepropagate-udp.t
@@ -23,7 +23,6 @@ ok(defined($s), 'type defined');
 
 my $new = IO::Socket::INET->new_from_fd($listener->fileno(), 'r+');
 
-local $TODO = "this information isn't cached for accepted sockets";
 is($new->sockdomain(), $d, 'domain match');
 SKIP: {
     skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL });

diff --git a/dist/IO/t/cachepropagate-unix.t b/dist/IO/t/cachepropagate-unix.t
index 2f8c55e..c336a73 100644 (file)
--- a/dist/IO/t/cachepropagate-unix.t
+++ b/dist/IO/t/cachepropagate-unix.t
@@ -76,7 +76,6 @@ ok(defined($s), 'type defined');
 
 my $new = IO::Socket::UNIX->new_from_fd($listener->fileno(), 'r+');
 
-$TODO = "this information isn't cached for new_from_fd sockets";
 is($new->sockdomain(), $d, 'domain match');
 SKIP: {
     skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL });