diff options
| author | Tony Cook <tony@develop-help.com> | 2012-06-13 21:21:49 +1000 |
|---|---|---|
| committer | Tony Cook <tony@develop-help.com> | 2012-07-02 18:44:13 +1000 |
| commit | dafec47dd840b2ba2153af4b21e710f71b9ba467 (patch) | |
| tree | fe2df1ad8756bbe6714caa200721003c3cf816ab /dist/IO | |
| parent | 76d04ca39f974c1aee23c29a9dda0a643740c988 (diff) | |
| download | perl-dafec47dd840b2ba2153af4b21e710f71b9ba467.tar.gz | |
[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.
Diffstat (limited to 'dist/IO')
| -rw-r--r-- | dist/IO/lib/IO/Socket.pm | 9 | ||||
| -rw-r--r-- | dist/IO/t/cachepropagate-udp.t | 1 | ||||
| -rw-r--r-- | dist/IO/t/cachepropagate-unix.t | 1 |
3 files changed, 9 insertions, 2 deletions
diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm index 5d4b19e2ab..9e6f769b1d 100644 --- 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 de18eae3a1..91cff376b2 100644 --- 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 2f8c55e1f8..c336a73c69 100644 --- 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 }); |