#!/usr/bin/perl

use strict;
use IO::Socket; 
use Socket;

# Kill output buffering for the shell output
BEGIN { $| = 1 }

# Holders for our stuff
my @players;
my $server_info = {};
my $server_version;
my $have_version = 0;
my @team_names = qw(None Alpha Bravo Charlie Delta Spectator);
my @mode_names = qw(DM PM TM CTF RM INF HTF);

# "Feed me a stray kitten!"
sub parse_refresh {
	my $handle = shift;
	my ($i, $sbuff, $len, $buff);

	# Get player names
	for ($i = 0; $i < 32; $i++) {

		# Get length of name
		recv($handle, $sbuff, 1, '');
		$len = unpack('W', $sbuff);

		# Get name using length
		recv($handle, $buff, $len, '');

		# Skip filler
		recv($handle, $sbuff, 24 - $len, '');
		
		# Start player reference
		$players[$i] = {};

		# Save name
		$players[$i]->{'name'} = $buff;

	}

	# Get player teams
	for ($i = 0; $i < 32; $i++) {
		recv($handle, $sbuff, 1, '');
		$players[$i]->{'team'} = unpack('W', $sbuff);
	}
	
	# Get player kills
	for ($i = 0; $i < 32; $i++) {
		recv($handle, $sbuff, 2, '');
		$players[$i]->{'kills'} = unpack('S', $sbuff);
	}
	
	# Get player deaths
	for ($i = 0; $i < 32; $i++) {
		recv($handle, $sbuff, 2, '');
		$players[$i]->{'deaths'} = unpack('S', $sbuff);
	}
	
	# Get player pings
	for ($i = 0; $i < 32; $i++) {
		recv($handle, $sbuff, 1, '');
		$players[$i]->{'ping'} = unpack('C', $sbuff);
	}
	
	# Get player IDs
	for ($i = 0; $i < 32; $i++) {
		recv($handle, $sbuff, 1, '');
		$players[$i]->{'id'} = unpack('C', $sbuff);
	}

	# Get player IPs
	for ($i = 0; $i < 32; $i++) {
		recv($handle, $sbuff, 4, '');
		$players[$i]->{'ip'} = join('.', unpack('CCCC', $sbuff));
	}

	# red team score
	recv($handle, $sbuff, 2, '');
	$server_info->{'score_alpha'} = unpack('S', $sbuff);

	# blue team score
	recv($handle, $sbuff, 2, '');
	$server_info->{'score_bravo'} = unpack('S', $sbuff);

	# charlie score
	recv($handle, $sbuff, 2, '');
	$server_info->{'score_charlie'} = unpack('S', $sbuff);

	# delta score
	recv($handle, $sbuff, 2, '');
	$server_info->{'score_delta'} = unpack('S', $sbuff);
	
	# map name len
	recv($handle, $sbuff, 1, '');
	$len  = unpack('W', $sbuff);
	recv($handle, $buff, $len, '');
	$server_info->{'map'} = $buff;
	recv($handle, $sbuff, 16 - $len, '');

	# Time limit
	recv($handle, $sbuff, 4, '');
	$server_info->{'time_limit'} = unpack('L', $sbuff);
	recv($handle, $sbuff, 4, '');
	$server_info->{'current_time'} = unpack('L', $sbuff);
	
	# Kill limit
	recv($handle, $sbuff, 2, '');
	$server_info->{'kill_limit'} = unpack('S', $sbuff);

	# Mode
	recv($handle, $sbuff, 1, '');
	$server_info->{'game_mode'} = $mode_names[unpack('W', $sbuff)];


}

my ($line, $buff);

# Connect
my $sock = new IO::Socket::INET (
	PeerAddr => 'server',
	PeerPort => '69',
	Proto => 'tcp')
|| die "Couldn't connect"; 

# Login 
print $sock "myPW\n";

# Request
print $sock "REFRESH\n";

# One char at a time since perl doesn't have fgets or something
while (recv($sock, $buff, 1, '') eq '') {

	# Reached the end of a line?
	if ($buff eq "\n") {

		# The goods?
		if ($line eq "REFRESH\r") {
			parse_refresh($sock);
			last;	# Only want it once for now
		}
		elsif ($have_version == 0 && $line =~ m/^Server Version: ([0-9\.]+)/){
			$have_version = 1;
			$server_version = $1;
		}

		# Kill line buffer
		$line = "";
	}

	# No; append to current line buffer
	else {
		$line .= $buff;
	}
}


# Kill socket handle
close $sock;

# Debug shiz


print "Version: $server_version\n";
print "Map: ".$server_info->{'map'}."\n\n";
print "Mode: ".$server_info->{'game_mode'}."\n\n";
print "Alpha Score: ".$server_info->{'score_alpha'}."\n";
print "Bravo Score: ".$server_info->{'score_bravo'}."\n\n";

print "Players:\n";
foreach my $player (@players) {

	# Skip empty player slots
	next if ($player->{'name'} eq '');

	print 
		"Player ID ".$player->{'id'}." (T: ".
		$team_names[$player->{'team'}].
		" K: ".$player->{'kills'}." D: ".
		$player->{'deaths'}." C: ".
		$player->{'caps'}." P:".$player->{'ping'}." ".
		"IP: ".$player->{'ip'}.
		"): ".$player->{'name'};


	print "\n";
}