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;

# import our helper modules
use Games::AssaultCube::MasterserverQuery;
use HTTP::Response;

my( $numtests, @replies );
BEGIN {
	$numtests = 0;

	eval "use Test::NoWarnings";
	if ( ! $@ ) {
		# increment by one
		$numtests++;

	}

	# setup our reply stuff
	@replies = (
		{
			name	=> 'invalid data',
			data	=> 'asdf13  asdlfk',
			invalid	=> 1,
		},
		{
			name	=> 'corrupt data',
			data	=> <<'END',
addserver 213.239.218.142 28323;
addserver 213.239.218.142 28333;
addserver 76.248.8.154 28763;
addserver 213.136.33.162 28763;
addserver 78.129.140.170
END

			invalid	=> 1,
		},
		{
			name	=> 'empty serverlist',
			data	=> '',
			attrs	=> {
				num_servers	=> 0,
				servers		=> [],
			},
		},
		{
			name	=> 'one server in the list',
			data	=> 'addserver 66.207.162.130 2000;',
			attrs	=> {
				num_servers	=> 1,
				servers		=> [
					{
						ip	=> '66.207.162.130',
						port	=> 2000,
					},
				],
			},
		},
		{
			name	=> 'many servers in the list',
			data	=> <<'END',
addserver 66.207.162.130 3000;
addserver 90.23.155.137 28763;
addserver 62.56.90.141 28763;
addserver 213.239.218.142 28243;
addserver 213.239.218.142 28253;
addserver 213.239.218.142 28323;
addserver 213.239.218.142 28333;
addserver 76.248.8.154 28763;
addserver 213.136.33.162 28763;
addserver 78.129.140.170 1337;
addserver 83.194.10.171 28763;
addserver 89.187.132.171 28763;
addserver 91.102.66.178 28763;
END

			attrs	=> {
				num_servers	=> 13,
				servers		=> [
					{
						ip	=> '66.207.162.130',
						port	=> 3000,
					},
					{
						ip	=> '90.23.155.137',
						port	=> 28763,
					},
					{
						ip	=> '62.56.90.141',
						port	=> 28763,
					},
					{
						ip	=> '213.239.218.142',
						port	=> 28243,
					},
					{
						ip	=> '213.239.218.142',
						port	=> 28253,
					},
					{
						ip	=> '213.239.218.142',
						port	=> 28323,
					},
					{
						ip	=> '213.239.218.142',
						port	=> 28333,
					},
					{
						ip	=> '76.248.8.154',
						port	=> 28763,
					},
					{
						ip	=> '213.136.33.162',
						port	=> 28763,
					},
					{
						ip	=> '78.129.140.170',
						port	=> 1337,
					},
					{
						ip	=> '83.194.10.171',
						port	=> 28763,
					},
					{
						ip	=> '89.187.132.171',
						port	=> 28763,
					},
					{
						ip	=> '91.102.66.178',
						port	=> 28763,
					},
				],
			},
		},
	);

	# add the tests
	foreach my $t ( @replies ) {
		if ( exists $t->{'invalid'} ) {
			$numtests += 1;
		} else {
			$numtests += 2;					# sanity tests
			$numtests += scalar keys %{ $t->{'attrs'} };	# attr tests
		}
	}
}

use Test::More tests => $numtests;

# setup our "fake" server object
my $query = Games::AssaultCube::MasterserverQuery->new();

# recreate the datagram!
foreach my $test ( @replies ) {
	# actually parse it
	my $response;
	eval {
		my $http = HTTP::Response->new( 200, undef, undef, $test->{'data'} );
		$response = Games::AssaultCube::MasterserverQuery::Response->new( $query, $http );
	};

	# Should it have died?
	if ( exists $test->{'invalid'} ) {
		is( defined $@, 1, "Parsed '" . $test->{'name'} . "' and died as expected" );
		next;
	} else {
		is( ! $@, 1, "Parsed '" . $test->{'name'} . "' with no errors" );
		diag( $@ ) if $@;
	}

	# some basic sanity tests
	$test->{'attrs'}->{'masterserver'} = 'http://masterserver.cubers.net/cgi-bin/AssaultCube.pl/retrieve.do?item=list';

	# test the result data!
	foreach my $attr ( sort keys %{ $test->{'attrs'} } ) {
		# what type of attr?
		if ( defined $test->{'attrs'}->{ $attr } ) {
			if ( ! ref( $test->{'attrs'}->{ $attr } ) ) {
				cmp_ok( $response->$attr(), 'eq', $test->{'attrs'}->{ $attr }, "Testing attribute($attr)" );
			} else {
				is_deeply( $response->$attr(), $test->{'attrs'}->{ $attr }, "Testing datastruct attribute($attr)" );
			}
		} else {
			is( ! defined $response->$attr(), 1, "Testing undef attribute($attr)" );
		}
	}
}