This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[rt.cpan.org #61577] try to populate socket info when not cached
authorTony Cook <tony@develop-help.com>
Wed, 13 Jun 2012 11:21:49 +0000 (21:21 +1000)
committerTony Cook <tony@develop-help.com>
Mon, 2 Jul 2012 08:44:13 +0000 (18:44 +1000)
The fixes are originally by Daniel Kahn Gillmor
<dkg@fifthhorseman.net>, but I've made other changes.

dist/IO/lib/IO/Socket.pm
dist/IO/t/cachepropagate-udp.t
dist/IO/t/cachepropagate-unix.t

index 5d4b19e..9e6f769 100644 (file)
@@ -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'};
 }
 
index de18eae..91cff37 100644 (file)
@@ -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 });
index 2f8c55e..c336a73 100644 (file)
@@ -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 });