File Coverage

blib/lib/Paranoid/Network/Socket.pm

Criterion	Covered	Total	%
statement	28	44	63.6
branch	3	18	16.6
condition			n/a
subroutine	8	8	100.0
pod	1	1	100.0
total	40	71	56.3

# Paranoid::Network::Socket -- Socket wrapper for seemless IPv6 support
#
# $Id: lib/Paranoid/Network/Socket.pm, 2.10 2022/03/08 00:01:04 acorliss Exp $
#
# This software is free software.  Similar to Perl, you can redistribute it
# and/or modify it under the terms of either:
#
#   a)     the GNU General Public License
#           as published by the
#          Free Software Foundation ; either version 1
#          , or any later version
#          , or
#   b)     the Artistic License 2.0
#          ,
#
# subject to the following additional term:  No trademark rights to
# "Paranoid" have been or are conveyed under any of the above licenses.
# However, "Paranoid" may be used fairly to describe this unmodified
# software, in good faith, but not as a trademark.
#
# (c) 2005 - 2020, Arthur Corliss ([e-mail])
# (tm) 2008 - 2020, Paranoid Inc. (www.paranoid.com)
#
#####################################################################

#####################################################################
#
# Environment definitions
#
#####################################################################

package Paranoid::Network::Socket;

use 5.008;

use strict;
use warnings;
use vars qw($VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS);
use base qw(Exporter);
use Socket qw(:all);

($VERSION) = ( q$Revision: 2.10 $ =~ /(\d+(?:\.\d+)+)/sm );

#####################################################################
#
# Module code follows
#
#####################################################################

our $ipv6_enabled;
our $socket6;

sub has_ipv6 {
    return $ipv6_enabled;
}

BEGIN {

    @EXPORT    = ( 'has_ipv6', @Socket::EXPORT );
    @EXPORT_OK = ( 'has_ipv6', @Socket::EXPORT_OK );
    %EXPORT_TAGS = (
        %Socket::EXPORT_TAGS,
        all => [ 'has_ipv6', @{ $Socket::EXPORT_TAGS{all} } ],
        );

    # Check to see if we've got any IPv6 functions available
    $socket6 = 0;
    $ipv6_enabled = ( defined *sockaddr_in6{CODE} ) ? 1 : 0;

    # Set inet_pton/inet_ntop to import by default -- don't know why
    # this isn't done in Socket at all...
    if ( grep { $_ eq 'inet_pton' } @EXPORT_OK ) {
        push @EXPORT, qw(inet_pton inet_ntop);
    }

    unless ($ipv6_enabled) {

        # Socket didn't provide it, let's see if Socket6 is available
        if ( eval 'require Socket6; 1;' ) {

            # Conditionally import Socket6 routines.  This is important
            # because perl 5.12 has partial IPv6 support, and 5.14 full.  I
            # want to avoid redefined and prototype mismatch warnings.
            for my $symbol (@Socket6::EXPORT) {
                unless ( grep /^$symbol$/s, @EXPORT, @EXPORT_OK ) {
                    import Socket6 $symbol;
                    push @EXPORT, $symbol;
                    push @{ $EXPORT_TAGS{all} }, $symbol;
                }
            }
            for my $symbol (@Socket6::EXPORT_OK) {
                unless ( grep /^$symbol$/s, @EXPORT, @EXPORT_OK ) {
                    import Socket6 $symbol;
                    push @EXPORT_OK, $symbol;
                    push @{ $EXPORT_TAGS{all} }, $symbol;
                }
            }
        }

        # Check one more time...
        $ipv6_enabled = ( defined *sockaddr_in6{CODE} ) ? 1 : 0;
        if ($ipv6_enabled) {
            $socket6 = *sockaddr_in{PACKAGE} eq 'Socket6' ? 1 : 0;
        }
    }
}

1;

__END__