#!/usr/bin/perl

use Test::More;
use Net::DNS::Resolver;

@prefixes = qw(
	       bl.spamcop.net
	       dnsbl.sorbs.net
	       list.dsbl.org
	       multihop.dsbl.org
	       unconfirmed.dsbl.org
	       );	

@rhsbls = qw(
	     postmaster.rfc-ignorant.org
	     dsn.rfc-ignorant.org
	     abuse.rfc-ignorant.org
	     bogusmx.rfc-ignorant.org
	     );	

SKIP: 
{

    if ($ENV{SKIP_RBL_TESTS})
    {
	plan tests => 2;
	diag ('');
	diag ('');
	diag('You have set $SKIP_RBL_TESTS to true, thus skipping');
	diag('testing that involves DNS queries.');
	diag ('');
	use_ok('Mail::RBL');
	skip 'User requested skipping of query tests', 1;
	diag ('');
    }

    plan  tests => @prefixes*4 + (grep {/spamcop/} @prefixes)*10 + 
	@rhsbls*16 + 1;

    diag('');
    diag('');
    diag('The following tests perform queries to some known RBLs.');
    diag('Failures do not necesarily mean that the code is broken');
    diag('If failures are seen, please insure that the relevant RBL');
    diag('Can be queried from this machine.');
    diag('');
    diag('You can skip this test by setting the environment variable');
    diag('$SKIP_RBL_TESTS to true');
    diag('');

    use_ok('Mail::RBL');

    for (@prefixes)
    {
	my $rbl_i = new Mail::RBL $_;
	my $rbl_e = new Mail::RBL $_, Net::DNS::Resolver->new;
	isa_ok($rbl_i, 'Mail::RBL');
	isa_ok($rbl_e, 'Mail::RBL');

	ok(!$rbl_i->check('127.0.0.1'), 
	   "Check localhost (unblocked) against $_");
	ok($rbl_i->check('127.0.0.2'), 
	   "Check 127.0.0.2 (blocked) against $_");
    }

    for (grep { $_ =~ /spamcop/ } @prefixes)
    {
	my $rbl_i = new Mail::RBL $_;
	my $rbl_e = new Mail::RBL $_, Net::DNS::Resolver->new;
	isa_ok($rbl_i, 'Mail::RBL');
	isa_ok($rbl_e, 'Mail::RBL');

	my @r_i = $rbl_i->check('127.0.0.1');
	my @r_e = $rbl_e->check('127.0.0.1');
	ok(!@r_i, "Localhost in array context against $_ (int res)");
	ok(!@r_e, "Localhost in array context against $_ (ext res)");
	@r_i = $rbl_i->check('127.0.0.2');
	@r_e = $rbl_i->check('127.0.0.2');
	ok(@r_i == 2, "127.0.0.2 in array context against $_ (int res)");
	ok(@r_e == 2, "127.0.0.2 in array context against $_ (ext res)");
	ok($r_i[0], "True block result (int res)");
	ok($r_e[0], "True block result (ext res)");
	ok($r_i[1], "Non-empty message returned (int res)");
	ok($r_e[1], "Non-empty message returned (ext res)");
    }

    for (@rhsbls)
    {
	my $rbl_i = new Mail::RBL $_;
	my $rbl_e = new Mail::RBL $_, Net::DNS::Resolver->new;

	isa_ok($rbl_i, 'Mail::RBL');
	isa_ok($rbl_e, 'Mail::RBL');

	ok(!$rbl_i->check_rhsbl('127.0.0.1'), 
	   "Check localhost rhsbl $_ (int res)");
	ok(!$rbl_e->check_rhsbl('127.0.0.1'), 
	   "Check localhost rhsbl $_ (ext res)");
	ok($rbl_i->check_rhsbl('example.tld'),
	   "Check example.tld rhsbl $_ (int res)");
	ok($rbl_e->check_rhsbl('example.tld'),
	   "Check example.tld rhsbl $_ (ext res)");

	my @r_i = $rbl_i->check_rhsbl('127.0.0.1');
	ok(!@r_i, "Localhost in array context is false: $_ (int res)");
	my @r_e = $rbl_e->check_rhsbl('127.0.0.1');
	ok(!@r_e, "Localhost in array context is false: $_ (ext res)");
	@r_i = $rbl_i->check_rhsbl('example.tld');
	@r_e = $rbl_i->check_rhsbl('example.tld');
	ok(@r_i, "Listed domain in array context is true: $_ (int res)");
	ok(@r_e, "Listed domain in array context is true: $_ (ext res)");
	ok(@r_i == 2, "Listed domain in array context count: $_ (int res)");
	ok(@r_e == 2, "Listed domain in array context count: $_ (ext res)");
	ok($r_i[0], "Domain in array context has value: $_ (int res)");
	ok($r_i[1], "Domain in array context non-empty message: $_ (int res)");
	ok($r_e[0], "Domain in array context has true value: $_ (ext res)");
	ok($r_e[1], "Domain in array context non-empty message: $_ (ext res)");
    }
}