File Coverage

blib/lib/Net/IP/XS.pm

Criterion	Covered	Total	%
statement	36	59	61.0
branch	0	8	0.0
condition			n/a
subroutine	22	26	84.6
pod	4	17	23.5
total	62	110	56.3

package Net::IP::XS;

use warnings;
use strict;

use 5.006;

use Math::BigInt;
use Tie::Simple;

our $VERSION = '0.21';

our $IP_NO_OVERLAP      = 0;
our $IP_PARTIAL_OVERLAP = 1;
our $IP_A_IN_B_OVERLAP  = -1;
our $IP_B_IN_A_OVERLAP  = -2;
our $IP_IDENTICAL       = -3;

our @EXPORT_OK = qw(Error
                    Errno
                    ip_iptobin
                    ip_bintoip
                    ip_iplengths
                    ip_bintoint
                    ip_inttobin
                    ip_expand_address
                    ip_is_ipv4
                    ip_is_ipv6
                    ip_get_version
                    ip_get_mask
                    ip_last_address_bin
                    ip_splitprefix
                    ip_is_valid_mask
                    ip_bincomp
                    ip_binadd
                    ip_get_prefix_length
                    ip_compress_v4_prefix
                    ip_is_overlap
                    ip_check_prefix
                    ip_range_to_prefix
                    ip_get_embedded_ipv4
                    ip_aggregate
                    ip_prefix_to_range
                    ip_reverse
                    ip_normalize
                    ip_compress_address
                    ip_iptype
                    ip_auth
                    ip_normal_range
                    $IP_NO_OVERLAP
                    $IP_PARTIAL_OVERLAP
                    $IP_A_IN_B_OVERLAP
                    $IP_B_IN_A_OVERLAP
                    $IP_IDENTICAL);

our %EXPORT_TAGS = (PROC => [@EXPORT_OK]);

use overload (
    '+'    => 'ip_add_num',
    'bool' => sub { @_ },
);

use base qw(DynaLoader Exporter);
__PACKAGE__->bootstrap($VERSION);

our $ERROR;
our $ERRNO;

BEGIN {
    tie $ERROR, 'Tie::Simple', 1, FETCH => \&ip_get_Error,
                                  STORE => \&ip_set_Error;
    tie $ERRNO, 'Tie::Simple', 1, FETCH => \&ip_get_Errno,
                                  STORE => \&ip_set_Errno;
};

our %IPv4ranges = (
    '00000000'                 => 'PRIVATE',     # 0/8
    '00001010'                 => 'PRIVATE',     # 10/8
    '01111111'                 => 'PRIVATE',     # 127.0/8
    '101011000001'             => 'PRIVATE',     # 172.16/12
    '1100000010101000'         => 'PRIVATE',     # 192.168/16
    '1010100111111110'         => 'RESERVED',    # 169.254/16
    '110000000000000000000010' => 'RESERVED',    # 192.0.2/24
    '1110'                     => 'RESERVED',    # 224/4
    '11110'                    => 'RESERVED',    # 240/5
    '11111'                    => 'RESERVED',    # 248/5
);

our %IPv6ranges = (
    '00000000'   => 'RESERVED',                  # ::/8
    '00000001'   => 'RESERVED',                  # 0100::/8
    '0000001'    => 'RESERVED',                  # 0200::/7
    '000001'     => 'RESERVED',                  # 0400::/6
    '00001'      => 'RESERVED',                  # 0800::/5
    '0001'       => 'RESERVED',                  # 1000::/4
    '001'        => 'GLOBAL-UNICAST',            # 2000::/3
    '010'        => 'RESERVED',                  # 4000::/3
    '011'        => 'RESERVED',                  # 6000::/3
    '100'        => 'RESERVED',                  # 8000::/3
    '101'        => 'RESERVED',                  # A000::/3
    '110'        => 'RESERVED',                  # C000::/3
    '1110'       => 'RESERVED',                  # E000::/4
    '11110'      => 'RESERVED',                  # F000::/5
    '111110'     => 'RESERVED',                  # F800::/6
    '1111101'    => 'RESERVED',                  # FA00::/7
    '1111110'    => 'UNIQUE-LOCAL-UNICAST',      # FC00::/7
    '111111100'  => 'RESERVED',                  # FE00::/9
    '1111111010' => 'LINK-LOCAL-UNICAST',        # FE80::/10
    '1111111011' => 'RESERVED',                  # FEC0::/10
    '11111111'   => 'MULTICAST',                 # FF00::/8
    '00100000000000010000110110111000' => 'RESERVED',    # 2001:DB8::/32

    '0' x 96 => 'IPV4COMP',                              # ::/96
    ('0' x 80) . ('1' x 16) => 'IPV4MAP',                # ::FFFF:0:0/96

    '0' x 128         => 'UNSPECIFIED',                  # ::/128
    ('0' x 127) . '1' => 'LOOPBACK'                      # ::1/128
);

sub Error       { $ERROR }
sub Errno       { $ERRNO }

sub ip_bintoint { Math::BigInt->new(ip_bintoint_str($_[0]))        }
sub ip_inttobin { ip_inttobin_str(Math::BigInt->new($_[0]), $_[1]) }

sub binip       { $_[0]->{'binip'}     }
sub version     { $_[0]->{'ipversion'} }
sub error       { $_[0]->{'error'}     }
sub errno       { $_[0]->{'errno'}     }
sub prefixlen   { $_[0]->{'prefixlen'} }
sub ip          { $_[0]->{'ip'}        }
sub is_prefix   { $_[0]->{'is_prefix'} }
sub binmask     { $_[0]->{'binmask'}   }

sub size        { Math::BigInt->new(size_str($_[0]))     }
sub intip       { Math::BigInt->new(intip_str($_[0]))    }
sub last_int    { Math::BigInt->new(last_int_str($_[0])) }

sub auth
{
    my ($self) = shift;

    return ($self->{auth}) if defined($self->{auth});

    my $auth = ip_auth($self->ip, $self->version);

    if (!$auth) {
        $self->{error} = $ERROR;
        $self->{errno} = $ERRNO;
        return;
    }

    $self->{auth} = $auth;

    return ($self->{auth});
}

sub ip_auth
{
    my ($ip, $ip_version) = (@_);

    if (not $ip_version) {
        $ERROR = "Cannot determine IP version for $ip";
        $ERRNO = 101;
        return;
    }

    if ($ip_version != 4) {
        $ERROR = "Cannot get auth information: Not an IPv4 address";
        $ERRNO = 308;
        return;
    }

    require IP::Authority;

    my $reg = new IP::Authority;

    return ($reg->inet_atoauth($ip));
}

1;

__END__