Skip Menu |

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

Report information
The Basics
Id: 97697
Status: new
Priority: 0/
Queue: Socket-GetAddrInfo

People
Owner: Nobody in particular
Requestors: fraserbn [...] gmail.com
Cc:
AdminCc:

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



Subject: [PATCH]Handle TCP and UDP on systems without getprotobyname()
This gets the module to install cleanly on Android.
Subject: 0001-Handle-TCP-and-UDP-on-systems-without-getprotobyname.patch
From e6991800baf3eaf8eeaf4501141dd2cb09acbe2e Mon Sep 17 00:00:00 2001 From: Brian Fraser <fraserbn@gmail.com> Date: Sat, 2 Aug 2014 13:23:04 +0200 Subject: [PATCH] Handle TCP and UDP on systems without getprotobyname() But really for Android. --- bin/getaddrinfo | 7 ++++++- lib/Socket/GetAddrInfo/Emul.pm | 10 ++++++++-- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/bin/getaddrinfo b/bin/getaddrinfo index a0f28cf..87a2497 100644 --- a/bin/getaddrinfo +++ b/bin/getaddrinfo @@ -96,6 +96,11 @@ my $host; my $service; my %hints; +my %proto_by_name = ( + tcp => IPPROTO_TCP, + udp => IPPROTO_UDP, +); + GetOptions( 'host|H=s' => \$host, 'service|S=s' => \$service, @@ -110,7 +115,7 @@ GetOptions( 'proto=s' => sub { my $proto = $_[1]; unless( $proto =~ m/^\d+$/ ) { - my $protonum = getprotobyname( $proto ); + my $protonum = $proto_by_name{$proto} || eval { getprotobyname( $proto ) }; defined $protonum or die "No such protocol - $proto\n"; $proto = $protonum; } diff --git a/lib/Socket/GetAddrInfo/Emul.pm b/lib/Socket/GetAddrInfo/Emul.pm index 1cefb69..c856b30 100644 --- a/lib/Socket/GetAddrInfo/Emul.pm +++ b/lib/Socket/GetAddrInfo/Emul.pm @@ -144,6 +144,11 @@ XS implementation does not recognise this constant. =cut +my %proto_by_name = ( + tcp => IPPROTO_TCP, + udp => IPPROTO_UDP, +); +my %proto_by_number = reverse %proto_by_name; sub getaddrinfo { my ( $node, $service, $hints ) = @_; @@ -197,7 +202,8 @@ sub getaddrinfo my @ports; # Actually ARRAYrefs of [ socktype, protocol, port ] my $protname = ""; if( $protocol ) { - $protname = getprotobynumber( $protocol ); + $protname = $proto_by_number{$protocol} + || getprotobynumber( $protocol ); } if( $service ne "" and $service !~ m/^\d+$/ ) { @@ -228,7 +234,7 @@ sub getaddrinfo $port = 0; } - push @ports, [ $this_socktype, scalar getprotobyname( $this_protname ) || 0, $port ]; + push @ports, [ $this_socktype, $proto_by_name{$this_protname} || eval {scalar getprotobyname( $this_protname ) } || 0, $port ]; } my @ret; -- 1.7.12.4 (Apple Git-37)