package    # hide form PAUSE
    Test::Data::Validate::IP;

use strict;
use warnings;

use Data::Validate::IP;
use Exporter qw( import );
use Test::More 0.88;

our @EXPORT = 'run_tests';

my $object = Data::Validate::IP->new();

my %ipv4_types = (
    private    => [qw(10.0.0.1 172.16.0.1 192.168.0.1)],
    public     => [qw(1.2.3.4 123.123.44.55 216.17.184.1)],
    loopback   => [qw(127.0.0.1)],
    testnet    => [qw(192.0.2.9)],
    multicast  => [qw(224.0.0.1)],
    linklocal  => [qw(169.254.0.1)],
    unroutable => [
        qw(
            0.0.0.1
            100.64.1.2
            192.0.0.4
            198.18.0.55
            203.0.113.44
            240.0.0.4
            255.255.255.254
            255.255.255.255
            )
    ],
);

my %ipv6_types = (
    private => [
        qw(
            fc00::
            fc01::1234
            fdef::
            fdff:ffff:ffff:ffff:ffff:ffff:ffff:ffff
            )
    ],
    public => [
        qw(
            ::abcd:1234
            1::
            2::
            1:1:1:1::
            2001:abcd::
            abcd::
            )
    ],
    loopback  => [qw(::1)],
    multicast => [
        qw(
            ff00::
            ffff::
            ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff
            )
    ],
    linklocal => [
        qw(
            fe80::
            fe89::
            febf::
            febf:ffff:ffff:ffff:ffff:ffff:ffff:ffff
            )
    ],
    special => [
        qw(
            2001::
            2001::1234
            2001:1ff:ffff:ffff:ffff:ffff:ffff:ffff
            )
    ],
);

sub run_tests {
    _ipv4_basic_tests();
    _type_tests(\%ipv4_types, 4);
    _ipv4_innet_tests();

    _ipv6_basic_tests();
    _type_tests(\%ipv6_types, 6);
}

sub _ipv4_basic_tests {
    my @valid_ipv4 = qw(
        0.0.0.0
        1.2.3.4
        216.17.184.1
        255.255.255.255
    );

    for my $ip (@valid_ipv4) {
        is(is_ipv4($ip),          $ip, "is_ipv4($ip) returns $ip");
        is($object->is_ipv4($ip), $ip, "->is_ipv4($ip) returns $ip");
    }

    my @invalid_ipv4 = qw(
        www.neely.cx
        216.17.184.G
        216.17.184.1.
        216.17.184
        216.17.184.
        256.17.184.1
        216.017.184.1
        016.17.184.1
    );

    for my $ip (@invalid_ipv4) {
        is(is_ipv4($ip),          undef, "is_ipv4($ip) returns undef");
        is($object->is_ipv4($ip), undef, "->is_ipv4($ip) returns undef");

        for my $type (sort keys %ipv4_types) {
            my ($is_sub_name, $is_sub) = _sub_for_type($type, 4);

            is($is_sub->($ip), undef, "$is_sub_name($ip) returns undef");
            is(
                $object->$is_sub_name($ip), undef,
                "->$is_sub_name($ip) returns undef"
            );
        }
    }
}

sub _ipv4_innet_tests {
    my @tests = (
        [ '216.17.184.1', '216.17.184.0/24', 1 ],
        [ '127.0.0.1',    '216.17.184.0/24', 0 ],
        [ 'invalid',      '216.17.184.0/24', 0 ],
        [ '1.2.3.4',      'default',         1 ],
    );

    for my $triplet (@tests) {
        my ($ip, $network, $is_member) = @{$triplet};

        my $expect = $is_member ? $ip : undef;

        my $expect_string = $expect || 'undef';
        is(
            is_innet_ipv4($ip, $network), $expect,
            "is_innet_ipv4($ip, $network) returns $expect_string"
        );
    }
}

sub _ipv6_basic_tests {
    my @valid = qw(
        2067:fa88::0
        2067:FA88::1
        2607:fa88::8a2e:370:7334
        2001:0db8:0000:0000:0000:0000:1428:57ab
        2001:0db8:0000:0000:0000::1428:57ab
        2001:0db8:0:0:0:0:1428:57ab
        2001:0db8:0:0::1428:57ab
        2001:0db8::1428:57ab
        2001:db8::1428:57ab
        ::
        ::0
        ::1
        ::ffff:12.34.56.78
        0:0:0:0:0:ffff:12.34.56.78
    );

    for my $ip (@valid) {
        is(is_ipv6($ip),          $ip, "is_ipv6($ip) returns $ip");
        is($object->is_ipv6($ip), $ip, "->is_ipv6($ip) returns $ip");
    }

    my @invalid = qw(
        2067:fa88
        2067:FA88
        2067:::
        2067:::1
        2067::1:
        216.17.184.1
        bbb.bbb.bbb
        :::
        g123::1234
    );

    for my $ip (@invalid) {
        is(is_ipv6($ip),          undef, "is_ipv6($ip) returns undef");
        is($object->is_ipv6($ip), undef, "->is_ipv6($ip) returns undef");
    }
}

sub _type_tests {
    my $types     = shift;
    my $ip_number = shift;

    my @types = sort keys %{$types};

    for my $type (@types) {
        for my $ip (@{ $types->{$type} }) {
            my ($is_sub_name, $is_sub) = _sub_for_type($type, $ip_number);

            is($is_sub->($ip), $ip, "$is_sub_name($ip) returns $ip");
            is(
                $object->$is_sub_name($ip), $ip,
                "->$is_sub_name($ip) returns $ip"
            );

            for my $other (grep { $_ ne $type } @types) {
                my ($isnt_sub_name, $isnt_sub)
                    = _sub_for_type($other, $ip_number);

                is(
                    $isnt_sub->($ip), undef,
                    "$isnt_sub_name($ip) returns undef"
                );
                is(
                    $object->$isnt_sub_name($ip), undef,
                    "->$isnt_sub_name($ip) returns undef"
                );
            }
        }
    }
}

sub _sub_for_type {
    my $type      = shift;
    my $ip_number = shift;

    my $sub_name = 'is_' . $type . '_ipv' . $ip_number;
    my $sub      = do {
        no strict 'refs';
        \&{$sub_name};
        }
        or die "No sub named $sub_name was not imported";

    return ($sub_name, $sub);
}

1;