File Coverage

blib/lib/Net/Works/Address.pm

Criterion	Covered	Total	%
statement	78	81	96.3
branch	17	22	77.2
condition	10	16	62.5
subroutine	21	24	87.5
pod	8	10	80.0
total	134	153	87.5

package Net::Works::Address;
$Net::Works::Address::VERSION = '0.20';
use strict;
use warnings;

use Carp qw( confess );
use Math::Int128 0.06 qw( uint128 uint128_to_hex uint128_to_number );
use Net::Works::Types qw( PackedBinary Str );
use Net::Works::Util qw(
    _integer_address_to_binary
    _integer_address_to_string
    _string_address_to_integer
    _validate_ip_string
);
use Scalar::Util qw( blessed );
use Socket 1.99 qw( AF_INET AF_INET6 inet_pton inet_ntop );

use integer;

# Using this currently breaks overloading - see
# https://rt.cpan.org/Ticket/Display.html?id=50938
#
#use namespace::autoclean;

use overload (
    q{""} => '_overloaded_as_string',
    '<=>' => '_compare_overload',
    'cmp' => '_compare_overload',
);

use Moo;

with 'Net::Works::Role::IP';

has _binary => (
    is      => 'ro',
    reader  => 'as_binary',
    isa     => PackedBinary,
    lazy    => 1,
    builder => '_build_binary',
);

has _string => (
    is      => 'ro',
    reader  => 'as_string',
    isa     => Str,
    lazy    => 1,
    builder => '_build_string',
);

sub BUILD {
    my $self = shift;

    $self->_validate_ip_integer();

    return;
}

sub new_from_string {
    my $class = shift;
    my %p     = @_;

    my $str     = delete $p{string};
    my $version = delete $p{version};

    if ( defined $str && inet_pton( AF_INET, $str ) ) {
        $version ||= 4;
        $str = '::' . $str if $version == 6;
    }
    else {
        $version ||= 6;
        _validate_ip_string( $str, $version );
    }

    return $class->new(
        _integer => _string_address_to_integer( $str, $version ),
        version  => $version,
        %p,
    );
}

sub new_from_integer {
    my $class = shift;
    my %p     = @_;

    my $int     = delete $p{integer};
    my $version = delete $p{version};
    $version ||= ref $int ? 6 : 4;

    return $class->new(
        _integer => $int,
        version  => $version,
        %p,
    );
}

sub _build_string {
    my $self = shift;

    return _integer_address_to_string( $self->_integer() );
}

sub _build_binary { _integer_address_to_binary( $_[0]->as_integer() ) }

sub as_integer { $_[0]->_integer() }

sub as_ipv4_string {
    my $self = shift;

    return $self->as_string() if $self->version() == 4;

    confess
        'Cannot represent IP address larger than 2**32-1 as an IPv4 string'
        if $self->as_integer() >= 2**32;

    return __PACKAGE__->new_from_integer(
        integer => $self->as_integer(),
        version => 4,
    )->as_string();
}

sub as_bit_string {
    my $self = shift;

    if ( $self->version == 6 ) {
        my $hex = uint128_to_hex( $self->as_integer() );
        my @ha  = $hex =~ /.{8}/g;
        return join '', map { sprintf( '%032b', hex($_) ) } @ha;
    }
    else {
        return sprintf( '%032b', $self->as_integer() );
    }
}

sub prefix_length { $_[0]->bits() }

sub mask_length { $_[0]->prefix_length() }

sub next_ip {
    my $self = shift;

    confess "$self is the last address in its range"
        if $self->as_integer() == $self->_max;

    return __PACKAGE__->new_from_integer(
        integer => $self->as_integer() + 1,
        version => $self->version(),
    );
}

sub previous_ip {
    my $self = shift;

    confess "$self is the first address in its range"
        if $self->as_integer() == 0;

    return __PACKAGE__->new_from_integer(
        integer => $self->as_integer() - 1,
        version => $self->version(),
    );
}

sub _compare_overload {
    my $self  = shift;
    my $other = shift;
    my $flip  = shift() ? -1 : 1;

    confess 'Cannot compare unless both objects are '
        . __PACKAGE__
        . ' objects'
        unless blessed $self
        && blessed $other
        && eval { $self->isa(__PACKAGE__) && $other->isa(__PACKAGE__) };

    return $flip * ( $self->as_integer() <=> $other->as_integer() );
}

__PACKAGE__->meta()->make_immutable();

1;

# ABSTRACT: An object representing a single IP (4 or 6) address

__END__