File Coverage

blib/lib/Net/NBsocket.pm

Criterion	Covered	Total	%
statement	103	132	78.0
branch	48	92	52.1
condition	13	33	39.3
subroutine	20	26	76.9
pod	11	14	78.5
total	195	297	65.6

#!/usr/bin/perl

package Net::NBsocket;
use strict;
#use diagnostics;

use vars qw(
	$VERSION @ISA @EXPORT_OK $UDP $TCP
);
use POSIX;
use NetAddr::IP::InetBase qw(
	ipv6_aton
	ipv6_n2x
	ipv6_n2d
	inet_pton
	inet_ntop
	AF_INET6
);
use AutoLoader 'AUTOLOAD';
require Socket;
import Socket qw(
	sockaddr_in
	sockaddr_un
	inet_aton
	inet_ntoa
	INADDR_ANY
	INADDR_BROADCAST
	INADDR_LOOPBACK
	INADDR_NONE
	AF_INET
	AF_UNIX
	SOCK_STREAM
	SOCK_DGRAM
	SO_LINGER
	SO_REUSEADDR
	SOL_SOCKET
	SOMAXCONN
);

require Exporter;

@ISA = qw(Exporter);

$VERSION = do { my @r = (q$Revision: 0.24 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };

# dynamic configuration for this HOST

# used a lot, create once per session
# SEGFAULTS with Apache mod_perl
#$UDP = getprotobyname('udp');
#$TCP = getprotobyname('tcp');

$UDP = 17;
$TCP = 6;

my $havesock6 = 0;
my $isupport6 = 0;
my $in6addr_any = ipv6_aton('::0');
my $in6addr_loopback = ipv6_aton('::1');

if (eval { require Socket6 } ) {	# have Socket6?
  $havesock6 = 1;
  import Socket6 qw(
	pack_sockaddr_in6
	unpack_sockaddr_in6
	in6addr_any
	in6addr_loopback
  );

  my $sock = do { local *SOCK; };

  if (socket($sock,AF_INET6(),SOCK_STREAM(),$TCP)) {
    $isupport6 = 1;
    close $sock;
  }
}
else {
  *pack_sockaddr_in6		= \&_dummy;
  *unpack_sockaddr_in6		= \&_dummy;
  *in6addr_any			= sub { return $in6addr_any };
  *in6addr_loopback		= sub { return $in6addr_loopback};
}

# get the index into sockaddr_in for the AF family byte
#

# return an index of '0' or '1' for the AF family byte
# '2' in the first rv indicates a not found
#  true in the second rv indicates "don't know"
#  neither of these conditions should occur

sub findAFi {
  my($af,$pa) = @_;
  my @pa = unpack('C2',$pa);
  my $pai;
  for ($pai = 0; $pai < 2; $pai++) {
    last if $pa[$pai] == $af;
  }
  my $unsure = 0;
  unless ($pai) {               # if $pai is zero
    $unsure = 1 if $pa[0] == $pa[1];
  }
  return wantarray
	? ($pai,$unsure)
	: $pai;
}

my($af_index,$unsure) = findAFi(AF_INET(),
	scalar sockaddr_in(1,INADDR_LOOPBACK()));

sub _af_index {
  return $af_index;
}

@EXPORT_OK = qw(
	open_UDP
	open_udpNB
	open_Listen
	open_listenNB
	connectBlk
	connect_NB
	accept_Blk
	accept_NB
	set_NB
	set_so_linger
	dyn_bind
	inet_aton
	inet_ntoa
	sockaddr_in
	sockaddr_un
	inet_pton
	inet_ntop
	ipv6_aton
	ipv6_n2x
	ipv6_n2d
	INADDR_ANY
	INADDR_BROADCAST
	INADDR_LOOPBACK
	INADDR_NONE
	in6addr_any
	in6addr_loopback
	AF_INET
	AF_INET6
	havesock6
	isupport6
	pack_sockaddr_in6
	unpack_sockaddr_in6
);

sub TCP {
  return $TCP;
}

sub UDP {
  return $UDP;
}

sub _dummy {
  return wantarray
	? ()
	: undef;
}

sub havesock6 {
  return $havesock6;
}

sub isupport6 {
  return $isupport6;
}

sub open_listenNB {
  my $lsock = &open_Listen;
  return $lsock if $lsock && set_NB($lsock);
  close $lsock if $lsock;
  return undef;
}

sub connectBlk {
  unshift @_,1;
  &_connect;
}

sub  connect_NB {
  unshift @_,0;
  &_connect;
}

sub accept_NB {
  unshift @_,0;
  my @rv = &_accept;
  return @rv if wantarray;
  return $rv[0] if @rv;
  return undef;
}

sub accept_Blk {
  unshift @_,1;
  my @rv= &_accept;
  return @rv if wantarray;
  return $rv[0] if @rv;
  return undef;
}

sub set_so_linger {
  my ($FH,$sec) = @_;
  setsockopt($FH,SOL_SOCKET(),SO_LINGER(),pack("ll",1,$sec));
}

sub DESTROY {};

1;

__END__