The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 42;

BEGIN { use_ok('Parse::DNS::Zone') }

my %zone_simple = (
	file=>'t/data/db.simple',
	origin=>'example.com.',
	mname=>'ns1.example.com.',
	rname=>'hostmaster.example.com.',
	serial=>1234567890,
	refresh=>86400,
	retry=>3600,
	expire=>3600000,
	minimum=>14400,
	names => {
		'@' => [qw/SOA NS A MX/],
		ns1 => [qw/A/],
		ns2 => [qw/A/],
		mail1 => [qw/A/],
		mail2 => [qw/A/],
		'test' => [qw/A AAAA/],
		'test-cname' => [qw/CNAME/],
		'test-reccname' => [qw/CNAME/],
		'test-dupes' => [qw/A/],
		'test-class' => [qw/A/],
		'test-ttl' => [qw/A/],
		'test-ttlclass' => [qw/A/],
		'test-ttlclassr' => [qw/A/],
		'test-include' => [qw/A AAAA/],
		'test-origapp' => [qw/CNAME/],
	},
);

$zone_simple{size} = int(keys %{$zone_simple{names}});

my %zone_nottl = (
	file => 't/data/db.nottl',
	origin => 'example.com.',
);

if(! -r $zone_simple{file}) {
	BAIL_OUT("$zone_simple{file} does not exist");
}

my $zone = Parse::DNS::Zone->new(
	zonefile=>$zone_simple{file},
	origin=>$zone_simple{origin},
);

is(
	$zone->get_rdata(name=>'@', rr=>'A'),
	$zone->get_rdata(name=>$zone_simple{origin}, rr=>'A'),
	"@ should translate to origin"
);

is(
	$zone->get_rdata(name=>'@', rr=>'NS'),
	'ns1.example.com.',
	"get NS rdata, ns1"
);

is(
	$zone->get_rdata(name=>'@', rr=>'NS', n=>1),
	'ns2.example.com.',
	"get NS rdata, ns2"
);

is(
	$zone->get_rdata(name=>'@', rr=>'NS', n=>0),
	scalar $zone->get_rdata(name=>'@', rr=>'NS'),
	"get NS rr dupe, 0 and implicit is equal"
);

is(
	$zone->get_dupes(name=>'@', rr=>'NS'),
	2,
	"get number of duplicate rrs with get_dupes()"
);

is(
	$zone->get_rdata(name=>'@', rr=>'A'),
	'127.0.0.1',
	'get A rr data'
);

is(
	$zone->get_rdata(name=>'@', rr=>'MX'),
	'10 mail1.example.com.',
	'get MX rdata with whitespace'
);

is(
	int($zone->get_names),
	$zone_simple{size},
	"expected number of names in zone"
);

ok($zone->exists('NS1.EXAMPLE.COM.'), "Case insensitivity 1");
ok($zone->exists('NS1.ExamplE.COM.'), "Case insensitivity 2");
is(
	$zone->get_rdata(name=>'NS1.ExaMplE.coM.', rr=>'a'),
	$zone->get_rdata(name=>'ns1.example.com.', rr=>'A'),
	'Case insensitivity 3',
);

ok($zone->exists('test'), "label test should exist");
ok($zone->exists('test.example.com.'), "test.example.com. should exist");
ok(! $zone->exists('.'), "root (.) should not exist in zone");
ok(! $zone->exists('fail'), "non existent domain should not exist");
ok(
	! $zone->exists('fail.example.com.'),
	"non existent domain should not exist (fqdn)"
);

ok(
	! $zone->get_rdata(name=>'example.com.', rr=>'TXT'),
	'commented out rr should not exist'
);

is(
	int($zone->get_rrs('test')),
	int(@{$zone_simple{names}->{test}}),
	"expected number of RRs for test"
);

is(
	$zone->get_rdata(name=>'test', rr=>'A'),
	'192.168.0.1',
	'get A rr data'
);

is(
	$zone->get_rdata(name=>'test', rr=>'AAAA'),
	'::1',
	'get AAAA rr data for test'
);

is(
	$zone->get_rdata(name=>'test-include', rr=>'A'),
	'192.168.128.1',
	'get A rr data from included file'
);

is(
	$zone->get_rdata(name=>'test-include', rr=>'AAAA'),
	'::1',
	'get AAAA rr data from included file'
);

is(
	$zone->get_dupes(name=>'test-dupes', rr=>'A'),
	3,
	"expected number of dupes for test-dupes"
);

{
	my @test = $zone->get_rdata(name=>'test-dupes', rr=>'A');
	is(
		int @test,
		3,
		'expected list from get_rdata(test-dupes) '.(@test)
	);
}

is($zone->get_mname, $zone_simple{mname}, "expected MNAME");
is($zone->get_rname, $zone_simple{rname}, "expected RNAME");

{
	my($rname) = $zone_simple{rname};
	$rname=~s/\./@/;
	is(
		$zone->get_rname(parse=>1),
		$rname,
		"expected RNAME (with parsing)"
	);
}

is($zone->get_serial, $zone_simple{serial}, "SOA serial");
is($zone->get_refresh, $zone_simple{refresh}, "SOA refresh");
is($zone->get_retry, $zone_simple{retry}, "SOA retry");
is($zone->get_expire, $zone_simple{expire}, "SOA expire");
is($zone->get_minimum, $zone_simple{minimum}, "SOA minimum");

is(
	$zone->get_rdata(name=>'test-class', rr=>'A', field=>'class'),
	'IN', 'Extract class data from rr'
);

is(
	$zone->get_rdata(name=>'test-ttl', rr=>'A', field=>'ttl'),
	'400', 'Extract ttl data from rr'
);

is(
	$zone->get_rdata(name=>'test-ttlclass', rr=>'A', field=>'class'),
	'IN', 'Extract class data from rr with class and ttl'
);

is(
	$zone->get_rdata(name=>'test-ttlclass', rr=>'A', field=>'ttl'),
	'400', 'Extract ttl data from rr with class and ttl'
);

is(
	$zone->get_rdata(name=>'test-ttlclassr', rr=>'A', field=>'class'),
	'IN', 'Extract class data from rr with class and ttl (reversed)'
);

is(
	$zone->get_rdata(name=>'test-ttlclassr', rr=>'A', field=>'ttl'),
	'400', 'Extract ttl data from rr with class and ttl (reversed)'
);

is(
	$zone->get_rdata(name=>'test-origapp', rr=>'CNAME', field=>'rdata'),
	'test', 'Do not append origin to RDATA if not told to do so'
);

$zone = Parse::DNS::Zone->new(
	zonefile=>$zone_simple{file},
	origin=>$zone_simple{origin},
	append_origin=>1,
);

is(
	$zone->get_rdata(name=>'test-origapp', rr=>'CNAME', field=>'rdata'),
	"test.$zone_simple{origin}", 'Append origin to RDATA if told to do so'
);

ok(
	eval { Parse::DNS::Zone->new(
		zonefile => $zone_nottl{file},
		origin => $zone_nottl{origin},
	)},
	'Should be possible to load zones without $TTL',
);