The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

use Test::More;
use Test2::Plugin::UTF8;

use Data::Validate::Domain;

{
    my @good = qw(
        www
        w-w
        neely
        com
        COM
        128
    );

    for my $l (@good) {
        my $disp = _display($l);
        is( is_domain_label($l), $l, qq{$disp is a valid domain label} );
    }

    my @bad = (
        undef,
        q{},
        '-bob',
        "bengali-\x{09ea}",
        ( 'x' x 70 ),
        "example\n",
    );

    for my $l (@bad) {
        my $disp = _display($l);
        ok( !is_domain_label($l), qq{$disp is not a valid domain label} );
    }
}

{
    my @good = qw(
        www.neely.cx
        www.neely.cx.
        neely.cx
        neely.cx.
        test-neely.cx
        aa.com
        A-A.com
        co.uk
    );

    for my $d (@good) {
        my $disp = _display($d);
        is( is_domain($d), $d, qq{$disp is a valid domain} );
    }

    my @bad = (
        undef,
        q{},
        qw(
            www.neely.cx...
            www.neely.lkj
            216.17.184.1
            test_neely.cx
            .neely.cx
            -www.neely.cx
            a
            .
            com.
            com
            net
            uk
            neely
            ),
        "bengali-\x{09ea}.com",
    );

    for my $d (@bad) {
        my $disp = _display($d);
        ok( !is_domain($d), qq{$disp is not a valid domain} );
    }

    ok(
        !is_domain( ( 'x' x 280 ) . '.com' ),
        '280 characters is not a valid domain'
    );
}

{
    my @good = qw(
        aa.com
        aa.bb
        aa
    );

    for my $h (@good) {
        my $disp = _display($h);
        is( is_hostname($h), $h, qq{$disp is a valid hostname} );
    }

    my @bad = (
        undef,
        q{},
        'x' x 256,
        '_foo.bar',
        "bengali-\x{09ea}.foo",
    );

    for my $h (@bad) {
        my $disp = _display($h);
        ok( !is_hostname($h), qq{$disp is not a valid hostname} );
    }
}

#Some additional tests for options
is(
    is_domain( 'myhost.neely', { domain_private_tld => { 'neely' => 1 } } ),
    'myhost.neely',
    'is_domain myhost.neely w/domain_private_tld option'
);
ok( !is_domain('myhost.neely'), 'is_domain myhost.neely' );
is(
    is_domain( 'com', { domain_allow_single_label => 1 } ),
    'com',
    'is_domain com w/domain_allow_single_label option'
);
is(
    is_domain(
        'neely', {
            domain_allow_single_label => 1,
            domain_private_tld        => { 'neely' => 1 }
        }
    ),
    'neely',
    'is_domain neely w/domain_private_tld  and domain_allow_single_label option'
);

is(
    is_hostname( '_spf', { domain_allow_underscore => 1 } ),
    '_spf',
    'is_hostname("_spf", {domain_allow_underscore = 1}'
);

#precompiled regex format
is(
    is_domain( 'myhost.neely', { domain_private_tld => qr/^neely$/ } ),
    'myhost.neely',
    'is_domain myhost.neely w/domain_private_tld option - precompiled regex'
);
ok(
    !is_domain( 'myhost.neely', { domain_private_tld => qr/^intra$/ } ),
    'is_domain myhost.neely w/domain_private_tld option - precompiled regex looking for intra'
);

my $obj = Data::Validate::Domain->new();
is( $obj->is_domain('co.uk'), 'co.uk', '$obj->is_domain co.uk' );

my $private_tld_obj = Data::Validate::Domain->new(
    domain_private_tld => {
        neely   => 1,
        neely72 => 1,
    },
);
is(
    $private_tld_obj->is_domain('myhost.neely'),
    'myhost.neely',
    '$private_tld_obj->is_domain myhost.neely'
);
is(
    $private_tld_obj->is_domain('myhost.neely72'),
    'myhost.neely72',
    '$private_tld_obj->is_domain myhost.neely72'
);
ok(
    !$private_tld_obj->is_domain('myhost.intra'),
    '$private_tld_obj->is_domain myhost.intra'
);
ok(
    !$private_tld_obj->is_domain('neely'),
    '$private_tld_obj->is_domain neely'
);

my $private_single_label_tld_obj = Data::Validate::Domain->new(
    domain_allow_single_label => 1,
    domain_private_tld        => {
        neely => 1,
    },
);

is(
    $private_single_label_tld_obj->is_domain('neely'),
    'neely',
    '$private_single_label_tld_obj->is_domain neely'
);
is(
    $private_single_label_tld_obj->is_domain('NEELY'),
    'NEELY',
    '$private_single_label_tld_obj->is_domain NEELY'
);
is(
    $private_single_label_tld_obj->is_domain('neely.cx'),
    'neely.cx',
    '$private_single_label_tld_obj->is_domain neely.cx'
);

#precompiled regex format
my $private_tld_obj2 = Data::Validate::Domain->new(
    domain_private_tld => qr/^(?:neely|neely72)$/,
);
is(
    $private_tld_obj2->is_domain('myhost.neely'),
    'myhost.neely',
    '$private_tld_obj2->is_domain myhost.neely'
);
is(
    $private_tld_obj2->is_domain('myhost.neely72'),
    'myhost.neely72',
    '$private_tld_obj2->is_domain myhost.neely72'
);
ok(
    !$private_tld_obj2->is_domain('myhost.intra'),
    '$private_tld_obj2->is_domain myhost.intra'
);
ok(
    !$private_tld_obj2->is_domain('neely'),
    '$private_tld_obj2->is_domain neely'
);

my $allow_underscore_obj = Data::Validate::Domain->new(
    domain_allow_underscore => 1,
);
is(
    $allow_underscore_obj->is_domain('_spf.neely.cx'),
    '_spf.neely.cx',
    '$allow_underscore_obj->is_domain _spf.neely.cx'
);
is(
    $allow_underscore_obj->is_domain('_sip._tcp.neely.cx'),
    '_sip._tcp.neely.cx',
    '$allow_underscore_obj->is_domain _sip._tcp.neely.cx'
);
is(
    $allow_underscore_obj->is_hostname('_spf'),
    '_spf',
    '$allow_underscore_obj->is_domain _spf'
);

done_testing();

sub _display {
    my $v = shift;

    return '<undef>' unless defined $v;
    return q{""} unless length $v;

    if ( length $v > 30 ) {
        return
              q{"}
            . substr( $v, 0, 30 )
            . q{ ... (}
            . ( length $v )
            . q{ chars)"};
    }

    $v =~ s/\n/\\n/;

    return qq{"$v"};
}