File Coverage

blib/lib/Net/Subnet.pm

Criterion	Covered	Total	%
statement	53	55	96.3
branch	17	22	77.2
condition	6	8	75.0
subroutine	18	18	100.0
pod	3	8	37.5
total	97	111	87.3

package Net::Subnet;

use strict;
use Socket;
BEGIN {
    if (defined &Socket::inet_pton) {
        Socket->import(qw(inet_pton AF_INET6));
    } else {
        require Socket6;
        Socket6->import(qw(inet_pton AF_INET6));
    }
};


use base 'Exporter';
our @EXPORT = qw(subnet_matcher subnet_classifier sort_subnets);

our $VERSION = '1.03';

sub cidr2mask_v4 {
    my ($length) = @_;
    return pack "N", 0xffffffff << (32 - $length);
}

sub cidr2mask_v6 {
    my ($length) = @_;
    return pack('B128', '1' x $length);
}

sub subnet_matcher {
    @_ > 1 and goto &multi_matcher;

    my ($net, $mask) = split m[/], shift;
    return $net =~ /:/
        ? ipv6_matcher($net, $mask)
        : ipv4_matcher($net, $mask);
}

sub ipv4_matcher {
    my ($net, $mask) = @_;

    $net = inet_aton($net);
    $mask = $mask =~ /\./ ? inet_aton($mask) : cidr2mask_v4($mask);

    my $masked_net = $net & $mask;

    return sub { ((inet_aton(shift) // return !1) & $mask) eq $masked_net };
}

sub ipv6_matcher {
    my ($net, $mask) = @_;

    $net = inet_pton(AF_INET6, $net);
    $mask = $mask =~ /:/ ? inet_pton(AF_INET6, $mask) : cidr2mask_v6($mask);

    my $masked_net = $net & $mask;

    return sub { ((inet_pton(AF_INET6,shift)//return!1) & $mask) eq $masked_net}
}

sub multi_matcher {
    my @v4 = map subnet_matcher($_), grep !/:/, @_;
    my @v6 = map subnet_matcher($_), grep  /:/, @_;

    return sub {
        $_->($_[0]) and return 1 for $_[0] =~ /:/ ? @v6 : @v4;
        return !!0;
    }
}

use constant MATCHER => 0;
use constant SUBNET  => 1;

sub subnet_classifier {
    #                    MATCHER,     SUBNET
    my @v4 = map [ subnet_matcher($_), $_ ], grep !/:/, @_;
    my @v6 = map [ subnet_matcher($_), $_ ], grep  /:/, @_;

    return sub {
        $_->[MATCHER]->($_[0]) and return $_->[SUBNET]
            for $_[0] =~ /:/ ? @v6 : @v4;
        return undef;
    }
}

sub sort_subnets {
    my @unsorted;
    for (@_) {
        my ($net, $mask) = split m[/];

        $mask = $net =~ /:/
            ? ($mask =~ /:/ ? inet_pton(AF_INET6, $mask) : cidr2mask_v6($mask))
            : ($mask =~ /\./ ? inet_aton($mask) : cidr2mask_v4($mask));

        $net = $net =~ /:/
            ? inet_pton(AF_INET6, $net)
            : inet_aton($net);

        push @unsorted, sprintf "%-16s%-16s%s", ($net & $mask), $mask, $_;
    }

    return map substr($_, 32), reverse sort @unsorted;
}

1;

__END__