Skip Menu |

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

Report information
The Basics
Id: 133686
Status: open
Priority: 0/
Queue: IO-Socket-IP

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

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



Subject: Cache protocol number lookups in IO::Socket::IP
We apply this optimization to IO::Socket::IP. I'm passing it to you in case you want to include it in a future release. diff --git a/lib/IO/Socket/IP.pm b/lib/IO/Socket/IP.pm index 3158ef5..5ab5759 100755 --- a/lib/IO/Socket/IP.pm +++ b/lib/IO/Socket/IP.pm @@ -38,8 +38,25 @@ use Errno qw( EINVAL EINPROGRESS EISCONN ENOTCONN ETIMEDOUT EWOULDBLOCK EOPNOTSU use constant HAVE_MSWIN32 => ( $^O eq "MSWin32" ); + +# getprotobyname reads /etc/protocols for every connection +# when making multiple connections is can be almost as much +# overhead as connect() when accessing localhost +my %proto_cache; +use constant HAVE_GETPROTOBYNAME => defined eval { $proto_cache{'tcp'} = getprotobyname('tcp') }; +sub _getprotobyname { + my ($proto) = @_; + + # Try to use the cached value. + $proto or return; # Not clear what we can do with undef/0/'' prototypes. + return $proto_cache{$proto} if exists $proto_cache{$proto}; + + # Not cached. Let's figure it out. + return $proto_cache{$proto} = getprotobyname($proto) if HAVE_GETPROTOBYNAME; + return $proto_cache{$proto} = eval { Socket->${\"IPPROTO_\U$proto"}() } +} + # At least one OS (Android) is known not to have getprotobyname() -use constant HAVE_GETPROTOBYNAME => defined eval { getprotobyname( "tcp" ) }; my $IPv6_re = do { # translation of RFC 3986 3.2.2 ABNF to re @@ -441,9 +458,7 @@ sub _io_socket_ip__configure if( defined( my $proto = $arg->{Proto} ) ) { unless( $proto =~ m/^\d+$/ ) { - my $protonum = HAVE_GETPROTOBYNAME - ? getprotobyname( $proto ) - : eval { Socket->${\"IPPROTO_\U$proto"}() }; + my $protonum = _getprotobyname($proto); defined $protonum or croak "Unrecognised protocol $proto"; $proto = $protonum; }
On Thu Nov 05 12:53:02 2020, TODDR wrote: Show quoted text
> We apply this optimization to IO::Socket::IP. I'm passing it to you in > case you want to include it in a future release.
Seems a reasonable idea. I'll tidy up the syntax a bit before applying it though. -- Paul Evans