#!/usr/local/bin/perl
############################################################################
# xpmon
# (c) 1996 Jonny Svärling
#
# An interface for launching xpilot
############################################################################

# require 'socket.ph';

$VERSION = '0.9b1';

############################################################################
# Default settings (can be changed using the rc-file)

# Server groups
$group{'all'} = $all_domains;
$group{'fast'} = '.se .no .fi'; 

# Metaservers in search order (server, port)

# Meta 1 (real name is xpilot.cs.uit.no)
$metaserver{'meta.xpilot.org'} = 4401;

# Meta 2 (real name is xpilot.mc.bio.uva.nl)
$metaserver{'meta2.xpilot.org'} = 4401;

# Current server
$current_server = 'hstud8';
$previous_input = 'hstud8 lgserv2';

# Xpilot commands
$xpilot_cmd{'default'} = "/home/d93/d93-jsv/xpilotstuff/xpilot-talk -maxColors 8 -color4 #EE00EE -geometry 1143x891+0+0 -scoreListFont 6x13 -messageFont variable -gameFont fixed";

# You can have different commands for different domains (why do you wan't 
# to have that? I don't know :-) Example:
#$xpilot_cmd{'.edu .se'} = "another or same xpilot command here";

############################################################################
# Global variables 
#
# current   - current server (used if no server is given)

############################################################################
# TODO
#
# kanske kolla flera parallellt?
# fet stil på en del text
# serverexp ---> ej reguljärt uttr.
# #serverexpr ---> reguljärt uttryck
# ping
# visa alla spelare som matchar ett visst uttryck
# klara case insensitive för icke-reguljära uttr (anv. substr nu...)

print("\n");
&print_hr;
print("XPilot Monitor $VERSION (c) 1996 Jonny Svärling\n");
&print_hr;
&get_list('xpilot.cs.uit.no', 4401);
&input_loop;

sub print_help {
    &print_hr;
    print " Help\n";
    &print_hr;
    print<<"StopPrinting";

XpMon can list active xpilot servers, show details about them etc.
You can even join a game (wow!).

 Commands
 -----------------
 l [all] [expr]    - Show active servers matching server expr.
                     Normally shows servers with more than one player but
                     if 'all' is specified all servers matching the expr
                     will be listed.
 [all] [expr]      - Short version of the same command
 d [expr]          - Show details about servers matching server expr
 j [server] [team] - Join a server
 p  [expr]         - List all players whose name (alias) match expr
 pr [expr]         - List all players whose real name (address) match expr
 q                 - Quit

A server expr is a list of (possibly incomplete) server names.
Eg: .se .cs.uit.no #\\.edu^
Normally, a server will match the server expr if one of the listed strings
match the server name (partially or fully) . If you put a '#' i front
of a string it will be interpreted as a regular expression.

You can see the current server in the prompt.
Some of the commands will use the current server if no server is given.

Type 'help setup' to find out how you can set up xpmon using a resource
file etc.
StopPrinting
}

# Usage: get_list (metaserver, port)
sub get_list {
    print("Contacting metaserver $_[0]...\n");
    if (!open(LIST, "telnet $_[0] $_[1] 2>&1 |")) {
	print "Couldn't telnet to $_[0] (port $_[1])\n";
	return;
    }
    @lines = <LIST>;
    close(LIST);

    %sinfo = ();
    $i = 1;
    foreach $line (@lines) {
	next if ($line !~ /:/);
	$line =~ /[^:]*:([^:]*):.*/;
	$sinfo{$1} = $line;
	$i++;
    }

}


# Usage: get_info(server)
sub get_info {
    # List structure
    # version : server : port : #players : map name : map size :
    # map author: status : max players : fps : player list :
    # sound : uptime : teams : race
    ($version, $server, $port, $nplayers, $mapname, $mapsize,
     $mapauthor, $status, $maxplayers, $fps, $playerlist,
     $sound, $uptime, $teams, $race) = split(/:/, $sinfo{$_[0]});

    # Player list structure
    # name1=realname1{team}, name2=realname2{team}, ...
    @players = split(/,/, $playerlist);    
}

sub get_player_details {
    if ($_[0] =~ /(.*)=(.*){(\d)}/) {
	$playername = $1;
	$playerreal = $2;
	$playerteam = $3;
    }
    else {
	$_[0] =~ /(.*)=(.*)/;
	$playername = $1;
	$playerreal = $2;
	$playerteam = 0;
    }
}

sub print_serverlist {
    local($type, $all, @servers) = @_;
    if ($type eq 'short') {
	&print_hr;
	printf (" %-30s %2s %s\n", 'Server', 'Pl', 'Map');
	&print_hr;
    }

#    foreach $s (@servers) {
#	if ($type eq 'short') {
#	    &print_server_info($s);
#	}
#	elsif ($type eq 'full') {
#	    &print_server_details($s);
#	}
#    }

    @unordered_servers = ();
    $i = 0;

    # Build up some info to sort
    foreach $s (@servers) {
	&get_info($s);
	@unordered_servers[$i++] = "$s $nplayers" if ($all || $nplayers>0);
    }
#    print "Un: <@unordered_servers>";
    @ordered_servers = sort(sort_func @unordered_servers);
#    print "Or: <@ordered_servers>";

    $s = $ordered_servers[0];
    ($s, $n) = split(/ /, $s);
    $current_server = $s if $s ne '';

    foreach $entry (@ordered_servers) {
	($s, $n) = split(/ /, $entry);
	if ($type eq 'short') {
	    &print_server_info($s);
	}
	elsif ($type eq 'full') {
	    &print_server_details($s);
	}
    }
}

sub sort_func {
    local($serv1, $npl1) = split(/ /, $a);
    local($serv2, $npl2) = split(/ /, $b);

    # Compare number of players
    return 1 if ($npl1 < $npl2);
    return -1 if ($npl1 > $npl2);

    return 0;
}

sub print_playerlist {
    local($type, @pexp) = @_;
    &print_hr;
    printf (" %-15s %-30s %-4s %s\n", 'Player', 'Fullname', 'Team', 'Server');
    &print_hr;

    local($n, $pn, $pa, $pt, $ps);
    $n = 0;
    foreach $p (&available_players) {
	($pn, $pr, $pt, $ps) = split(/,/, $p);
	foreach $patt (@pexp) {
	    if (($type eq 'p' && &match($pn, $patt)) ||
		($type eq 'pr' && &match($pr, $patt))) {
		$pt = '-' if $pt == 0;
		printf (" %-15s %-30s %-4s %s\n",
			$pn, substr($pr, 0, 30), 
			$pt, substr($ps, 0, 30));
		$n++;
	    }
	}
    }

    if ($n == 1) {
	print "\n $n player matching the expression was found...\n";
    }
    else {
	print "\n $n players matching the expression were found...\n";
    }
}

sub print_server_info {
    local($serv) = @_;
    &get_info($serv);

    printf(" %-30s %-2d %s\n",
	   substr($server, 0, 30),
	   $nplayers, $mapname);
}

sub print_server_details {
    local($serv) = @_;
    &get_info($serv);
    
    &print_hr;
    printf("%-40s\n", $serv);
    &print_hr;

    $h = int($uptime / 3600);
    $m = $uptime % 3600;
    $u = "$m min";
    $u = "$h h $u" if ($h > 0);

    printf("Status   %s\n", $status);
    printf("Version  %s\n", $version);
    printf("Map      %s\n", $mapname);
    printf("Author   %s\n", $mapauthor);
    printf("Uptime   %s\n", $u);
    if ($teams == 0) {
	printf("Teams    No teams\n");
    }
    else {
	printf("Teams    %s\n", $teams);
    }
    printf("Players  %d/%d\n", $nplayers, $maxplayers);
    foreach $p (@players) {
	&get_player_details($p);
	if ($teams != 0) {
	    printf("         %-15s  %2d  %s\n",
		   $playername, $playerteam, $playerreal);
	}
	else {
	    printf("         %-15s  %s\n",
		   $playername, $playerreal);
	}
    }

    $current_server = $serv;    
}

sub input_loop {
    local($inp);
    local(@list);
    @list = ('hstud', 'gorf', 'foobar');
    while (1) {
	print "\n[$current_server] >>> ";
	$inp = &get_line_input;
	if (!&parse_input($inp)) {
	    last;
	}
    }
    
}

sub get_line_input {
    local($line);
    while (1) { 
	$c = getc(STDIN);
	last if ($c eq "\n" || $c eq '');
	$line .= $c;
    }
    return $line;
}

sub parse_input {
    local($input) = $_[0];

    if ($input eq '') {
	$input = $previous_input;
    }
    else {
	$previous_input = $input;
    }
    
    local(@tok);
    @tok = split(/ /, $input);
    local($cmd) = $tok[0];
    local(@servers);

    if ($cmd eq '') {
	$cmd = return 1;
    }

    if ($cmd eq 'bye' || $cmd eq 'q' || $cmd eq 'quit' || $cmd eq 'exit') {
	print "Bye...\n";
	return 0;
    }
    elsif ($cmd eq 'h' || $cmd eq 'help' || $cmd eq '?') {
	&print_help;
    }
    elsif ($tok[0] eq 'd') {
	shift(@tok);
	local($all) = 0;
	if ($tok[0] eq 'all') {
	    shift @tok;
	    $all = 1;
	}
	push(@tok, $current_server) if @tok == 0;
	&get_list('meta.xpilot.org', 4401);
	@servers = &matched_servers(@tok);
	&print_serverlist('full', $all, @servers);       
    }
    elsif ($tok[0] eq 'j') {
	$s = $tok[1];
	$s = $current_server if $s eq '';
	@servers = &matched_servers($s);
	&join_server(@servers[0], $tok[2]);	    
    }
    elsif ($tok[0] eq 'p' || $tok[0] eq 'pr') {
	local($type) = @tok[0];
	&get_list('meta.xpilot.org', 4401);
	if (@tok == 1) {
	    &print_playerlist($type, '#.*');
	}
	else {
	    shift @tok;
	    &print_playerlist($type, @tok);
	}
    }
    else {
	# Show short info about serves
	if ($cmd eq 'l') {
	    shift(@tok);
	}
	local($all) = 0;
	if ($tok[0] eq 'all') {
	    shift @tok;
	    $all = 1;
	}

	&get_list('meta.xpilot.org', 4401);
	push(@tok, '#.*') if (@tok == 0);
	@servers = &matched_servers(@tok);
	if (@servers == 0) {
	    print "No server match your expression.\n";
	}
	else {
	    &print_serverlist('short', $all, @servers);       
	}
    }
    return 1;
}

# Usage: get_fullnames(serverlist)
# Gets the full name of the given server expressions
# Ex:
# @servers = &get_servers('.se cs.uit.no');
# The servers foo.se, bar.se, foo.cs.uit.no and hstud.cs.uit.no will
# be returned.
sub get_fullnames {
    foreach $s (@serverlist) {
    }
}

sub get_fullname {
    foreach $s (&available_servers) {
	
    }
}

sub matched_servers {
    local(@servers) = ();

    foreach $s (&available_servers) {
	foreach $sname (@_) {
	    push (@servers, $s) if (&match($s, $sname));
	}
    }
    return @servers;
}

# Usage: match(fullname, pattern)
sub match {
    local($full, $patt) = @_;


    #print "Full: $full, Patt: $patt\n";
    if (index($patt, '#') != -1) {
	# Regular expression
	$p = substr($patt, 1);
	if ($full =~ /$p/i) {
	    return 1;
	}
    }
    else {
	# Normal expression
	if (index($full, $patt) != -1) {
	    return 1;
	}
    }
    return 0;
}

sub get_single_server {
    local($serv) = $_[0];
    local(@servers);
   
    if ($serv =~ /^\d+$/) {
	# Server number
	@servers = &available_servers;
 	return $servers[$serv];
    }
    else {
	@servers = &matched_servers($serv);
	return $servers[0];
    }
    
}

sub available_servers {
    return keys(%sinfo);
}

sub available_players {
    local(@pl);
    
    foreach $s (&available_servers) {
	&get_info($s);
	foreach $p (@players) {
	    &get_player_details($p);
	    if ($playerreal ne 'robot@robots.org') {
		push (@pl, "$playername,$playerreal,$playerteam,$s");
	    }
	}
    }
    return @pl;
}

sub join_server {
    local($serv, $team) = @_;

    local($cmd) = &get_xpilot_command($serv);
    $cmd .= " $serv";

    if ($team =~ /\d+/ && $team > 0) {
	print("Joining team $team on $serv...\n");
	$cmd .= " -team $team";
    }
    else {
	print("Joining $serv...\n");
    }
    print "$cmd\n";
    system($cmd);

    $current_server = $serv;
}

sub get_xpilot_command {
    local($serv) = @_;

    # Special command for this server?
    local(@patts);
    foreach $s (keys %xpilot_cmd) {
	@patts = split(/ /, $s);
	foreach $p (@patts) {
	    if (&match($serv, $p)) {
		return $xpilot_cmd{$s};
	    }
	}
    }

    # No, use default command
    return $xpilot_cmd{'default'};
}

sub print_hr {
    print '-' x 80; print "\n";
}