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;
}