File Coverage

blib/lib/Net/IP/Identifier_Role.pm

Criterion	Covered	Total	%
statement	36	57	63.1
branch	8	24	33.3
condition	7	15	46.6
subroutine	10	14	71.4
pod	5	6	83.3
total	66	116	56.9

#===============================================================================
#      PODNAME:  Net::IP::Identifier_Role
#     ABSTRACT:  The role that Net::IP::Identifier plugins must satisfy
#
#       AUTHOR:  Reid Augustin (REID)
#        EMAIL:  [e-mail]
#      CREATED:  Mon Oct  6 12:25:04 PDT 2014
#===============================================================================

use 5.008;
use strict;
use warnings;

package Net::IP::Identifier_Role;

use Role::Tiny;
use Net::IP;
use Net::IP::Identifier::Net;

our $VERSION = '0.111'; # VERSION

requires qw( new name );

use overload '""' => sub { shift->name };

sub ips {
    my ($self, @new) = @_;

    if (@_ > 1) {
        for (my $ii = 0; $ii < @new; $ii++) {
            my $cidr = $new[$ii];
            my $ip;
            if (ref $cidr) {    # already a Net::IP or Net::IP::Identifier::Net
                $ip = $cidr;
                if (ref $ip eq 'Net::IP') {
                    # convert Net::IP to Net::IP::Identifier::Net
                    $ip = Net::IP::Identifier::Net->new($ip);
                }
            }
            else {
                if (defined $new[$ii + 1] and
                    not ref $new[$ii + 1] and
                    $new[$ii + 1] eq '-' and
                    defined $new[$ii + 2]) {
                    $cidr = "$cidr - $new[$ii + 2]";
                    $ii += 2;
                }
                $ip = Net::IP::Identifier::Net->new($cidr)
            }
            $self->{ips}{"$ip"} = $ip if ($ip); # stringify $ip for key
        }
    }

    return wantarray
    ? values %{$self->{ips}}
    : $self->{ips};
}

sub cidrs {
    my ($self, @new) = @_;

    return wantarray
    ? keys %{$self->{ips}}
    : $self->{ips};
}

sub identify {
    my ($self, $ip, $replacement) = @_;

    $ip = Net::IP::Identifier::Net->new($ip) if (not ref $ip);
    for my $net (values %{$self->ips}) {
        # if different versions, can't be overlap (unless entity gets
        # some ::ffff:N:N:N:N/N blocks which seems unlikly)
        next if ($net->version ne $ip->version);
        my $overlap = $ip->overlaps($net);
        if ($overlap == $IP_IDENTICAL or
            $overlap == $IP_A_IN_B_OVERLAP) {
            return $net if ($self->cidr_id);
            return $replacement || $self;
        }
    }
    return; # undef, doesn't belong to entity
}

sub cidr_id {
    my ($self, @new) = @_;

    if (@_ > 1) {
        $self->{cidr_id} = $new[0];
    }
    return $self->{cidr_id};
}

sub refresh {
    # stub, may be overridden by entities to refresh the ips array
}

sub children {
    # stub, entities with children should return an array of the names here
    # (and the child netblocks should not be listed in the parent)
}

1;

__END__