#!/usr/bin/perl

# quake3.pl by ]D[  -  QUAKE III: ARENA SERVER MONITOR  -  version 2.2.2
#---------------------------------------------------------------------
#
# Qsmon was originally written to query Quake servers using qstat.
# I've taken it a few steps further however and added a few new
# features. Many of the features in this script are edited out
# right now, and must be hand edited back in, because I've set this
# up for querying Quake 3 servers.
#
# Acknowledgments
# ---------------
# Steve Wainstead - Help on 2.1 rewrite
# Mike "Pestilence" Hallock - maintainer
#
#
#---------------------------------------------------------------------

######################################################################
# SETTINGS
######################################################################

# If you only want to monitor one Quake 3 server, uncomment this line 
# and change the address to the address of your server
#@Quake3Servers = ('xxx.xxx.xxx.xxx:xxxxx');

# Colors and background settings for the web pages.
$BodyArgs = "bgcolor=\"#000000\" text=\"#C0C0C0\" link=\"#0080FF\" vlink=\"#0080FF\" alink=\"#C0C0C0\"";

# Web page table parameters.
$TableArgs = "border=\"1\" cellspacing=\"0\" cellpadding=\"1\"";

# QstatPath specifies where I can find the qstat executable. This path 
# MUST be here.
$QstatPath = "./qstat";

# The URL for this script.  Most HTTP servers will set the
# environment variables SERVER_NAME and SCRIPT_NAME which can be used
# to construct the script's URL.  If this doesn't work, then just go
# ahead and use a hard-coded URL like this:
# $ScriptURL = 'http://www.my.host/cgi-bin/qsmon.cgi';
$ScriptURL = "http://$ENV{'SERVER_NAME'}$ENV{'SCRIPT_NAME'}";

# This is new here: I am puting this in for image finding easier.
# By default it grabs the map images from LinuxQuake.com, which
# is probably the definitive source for map images fitting the
# size in this script:
$ImageURL = "http://www.ptarena.net/qsmon";


#######################################################################
#  MAIN PROGRAM
#######################################################################

# First tell Perl to bypass the buffer so in case the HTTP server is
# bogged down we won't get timed-out.  Then output the 'magic' HTML
# header so that the HTTP server knows this is an HTML document.
# This will also allow us to output any debugging info to the web.
# the web and so that in the case of a bogged down server, we won't
# get timed-out. 

$! = 1;
print "Content-type: text/html\n\n";

# What to do?  If the list of Quake servers is set in this program,
# use them.  If a list of servers is provided via CGI, use them.  If
# no servers were specified, output a form so the user can supply a
# server list.
if (!@Quake3Servers) {
	$Result = &ReadParse;
	if ($Result) {
		if ($in{'Quake3Servers'} ne "") {
			@Value = split(/,/, $in{'Quake3Servers'});
		} else { 
			@Value = split(/,/, $in); 
		}
		foreach (@Value) { 
			push (@Quake3Servers, $_); 
		}
	} else {
		&OutputForm;
	}
}

# Do this loop for each server
foreach (@Quake3Servers) {

	# Run qstat and split results into 3 groups
	split(/\n/,`$QstatPath -R -P -cn -tsw -q3s $_ -raw,,`);
	$GeneralLine = shift(@_);
	$RulesLine = shift(@_);
	@PlayerLines = @_;

	# Split general and rules info into seperate variables
	@General = split(/,,/,$GeneralLine);
	for (split ',,', $RulesLine) {
		# split each value on '='
		if (($var_name, $var_value) = split /=/) {
			${$var_name} = $var_value; # create a variable with the name given
		}
	}

	# Check to see if the server is not responding
	if ($General[2] eq 'DOWN') {
		print qq!
			$GeneralLine
			<table $TableArgs>
			<tr align="center">
			<th><tt><font size="+2">$_ Nao responde...</font></tt></th>
			</tr>
			<tr align="center">
			<td>O Servidor de Quake em <b>$_</b> nao responde. O Servidor parece estar em baixo
			ou temporariamente indisponivel.</td>
			</tr>
			</table>
			<hr>
		!;
		next;
	}

	# Let's set some of the default settings
	if ($fraglimit == 0) { 
		$fraglimit = 'None'; 
	}
	if ($dmflags == 0) { 
		$dmflags = 'Default'; 
	}	   
	if ($timelimit == 0) { 
		$timelimit = 'None'; 
	}
	$map = $General[3];


	# Now that we have all of the actual informational stuff done, let's print
	# it out:
	# Output the entire dynamic HTML stuff

	print qq!
		<head>
		<title>Quake 3 Arena Server Status</title>
		</head>
		<body $BodyArgs>
		<script language="javascript">
			setTimeout('location.href="$ScriptURL?$ENV{'QUERY_STRING'}"', 100000);
		</script>
		<br>
		<center>

		<TABLE WIDTH="0" BORDER="0" CELLSPACING="1" CELLPADDING="1" ALIGN="center">
		<TR>
			<TD WIDTH="0" HEIGHT="0" ALIGN="center"><FONT FACE="Arial" COLOR="#ffffff"><B>PlanetQuake3.net's RA3 Server</B></FONT></TD>
		</TR>
		</TABLE>
		<BR>

		<table align="center" width="500">
		<tr>  
		<td valign="top" width="600">
		
		<b>Name</b>: $General[2]<br><br>
		<b>Server IP</b>: $General[1]<br><br>
		<b>Game Type:</b> $gamename <br><br>
		<b>Dmflags:</b> $dmflags <br><br>
		<b>Timelimit:</b> $timelimit <br><br>
		<b>Fraglimit:</b> $fraglimit <br><br>
		<b>Players / Max</b>: $General[5] / $General[4]<br><br>   
		<b>Ping / Timeout</b>: $General[6] / $General[7]<br><br>
		<b>Map</b>: $map<br><br>
		<b>Map Image</b>: <img src="$ImageURL/q3a/$map.jpg" width="211" height="158" alt="$map" align="top">

		<td valign="top">
		<center><font size="+1"><b>Players</b></font></center>
		<table $TableArgs valign="top" width="100%">
		<tr align="center">
		<tr>
		<td width="190" align="center"><b>Name</b></td>
		<td width="30"><b>Ping</b></td>
		<td width="30"><b>Frags</b></td>
		</tr>
	!;

	# Check to see if there's enter">
		<tr>
		<td width="190" align="center"><b>Name</b></td>
		<td width="30"><b>Ping</b></td>
		<td width="30"><b>Frags</b></td>
		</tr>
	!;

	# Check to see if there's more than 0 players
	if ($General[5] == 0) {
		print "<tr align=\"center\"><td colspan=6>No Players</td></tr>\n";
	} else {
		# Sort the players by frags
		foreach $I (0 .. $#PlayerLines) {
			($Name[$I], $Frags[$I], $TheRest[$I]) = split(/,,/, $PlayerLines[$I]);
			$Frags[$I] = $Frags[$I] . ".$I";
		}
		@Name = ();
		@Address = ();
		@TheRest = ();
		@SortedFrags = sort {$b <=> $a} @Frags;
		@Frags = ();
		@SortedPlayerLines = ();
		foreach $I (0 .. $#SortedFrags) {
			($Frags, $Index) = split(/\./, $SortedFrags[$I]);
			push (@SortedPlayerLines, $PlayerLines[$Index]);
		}

		# Ouput the player table data
		foreach (@SortedPlayerLines) {
			@Player = split(/,,/,$_);

			$Player[0] =~ s/90/<font color=000000>/g;
			$Player[0] =~ s/91/<font color=ff0000>/g;
			$Player[0] =~ s/92/<font color=00ff00>/g;
			$Player[0] =~ s/93/<font color=ffff00>/g;
			$Player[0] =~ s/94/<font color=0000ff>/g;
			$Player[0] =~ s/95/<font color=3399ff>/g;
			$Player[0] =~ s/96/<font color=604080>/g;
			$Player[0] =~ s/97/<font color=ffffff>/g;
			# Output a table row for each player
			print qq!
				<tr>
				<td align="center">$Player[0]</font></td>
				<td>$Player[2]</td>
				<td>$Player[1]</td>
				</tr>
			!;
		}
  	}

	print qq!
		</table> 
		</table>
		</center>
	!;


} # End of the server stats loop...

print qq!
	<BR>
	<TABLE WIDTH="705" BORDER="0" CELLSPACING="1" CELLPADDING="1" ALIGN="center">
	<TR>
		<TD WIDTH="700" COLSPAN="2" ALIGN="right" BGCOLOR="#333333"><FONT FACE="Arial" SIZE="-2"><A HREF="http://www.linuxquake.com/qsmon">&copy; QSMON</A></FONT></TD>
	</TR>
	</TABLE>
!;

exit;
# End of the main program



#######################################################################
# SUB ROUTINES
#######################################################################

# Display the form for entering Quake server(s)
sub OutputForm {
	print qq!
		<html>
		<head>
		<title>PORTUGAL ARENA - Quake 3 Arena Server Monitor</title>
		</head>
		<body $BodyArgs>

		<TABLE WIDTH="705" BORDER="0" CELLSPACING="1" CELLPADDING="1" ALIGN="center">
		<TR>
			<TD WIDTH="100" HEIGHT="80" ALIGN="center" BGCOLOR="#000042"><FONT FACE="Arial"><B><A HREF="http://www.ptarena.net">PORTUGAL ARENA</A></B></FONT></TD>
			<TD WIDTH="700" HEIGHT="80" ALIGN="center" BGCOLOR="#000042"><FONT FACE="Arial" COLOR="#DDA116"><B>QUAKE 3 ARENA SERVER MONITOR</B></FONT></TD>
		</TR>
		</TABLE>
		<BR>

		<center>
		<form method="post" action="$ScriptURL">
		<p><FONT FACE="Arial"><b>Servidor(es) de Quake3:</b></FONT>   
		<input type="text" name="Quake3Servers" size="60">
		</form>
		</center>
		<p>
		<TABLE ALIGN="center" WIDTH="700" CELLSPACING="2" CELLPADDING="2" BORDER="0">
		<TR>
		    <TD ALIGN="left">
			<FONT FACE="Arial" SIZE="2">
			Para ver o Status de um Servidor de Quake3, insira o seu IP
			(<I>ex: 123.456.789.123</I>) ou Host name
			(<I>ex: quake3.telepac.pt</I>) na textbox e carregue na tecla ENTER.
			Para monitorizar varios Servidores, separe os enderecos por virgulas
			(<I>ex: quake3.netc.pt,quake3.teleweb.pt</I>).
			</FONT>
			</TD>
		</TR>
		</TABLE>
		
		<BR>
		<TABLE WIDTH="705" BORDER="0" CELLSPACING="1" CELLPADDING="1" ALIGN="center">
		<TR>
			<TD WIDTH="700" COLSPAN="2" ALIGN="right" BGCOLOR="#333333"><FONT FACE="Arial" SIZE="-2"><A HREF="http://www.linuxquake.com/qsmon">&copy; QSMON</A></FONT></TD>
		</TR>
		</TABLE>

		</body>
		</html>
	!;
	exit;
}

# ReadParse
# Reads in GET or POST data, converts it to unescaped text, and puts
# one key=value in each member of the list "@in"
# Also creates key/value pairs in %in, using '\0' to separate multiple
# selections

# Returns TRUE if there was input, FALSE if there was no input
# UNDEF may be used in the future to indicate some failure.

# Now that cgi scripts can be put in the normal file space, it is useful
# to combine both the form and the script in one place.  If no parametersM
# are given (i.e., ReadParse returns FALSE), then a form could be output.M

# If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse,M
# information is stored there, rather than in $in, @in, and %in.M

sub ReadParse {
	local (*in) = @_ if @_;
	local ($i, $key, $val);

	# Read in text from form
	if ($ENV{'REQUEST_METHOD'} eq "GET") {
		$in = $ENV{'QUERY_STRING'};
	} elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
		read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
	}

	# Read in query from ISINDEx
	if ($ENV{'HTTP_SEARCH_ARGS'} ne "") { 
		$in = $ENV{'HTTP_SEARCH_ARGS'}; 
	}

	@in = split(/&/,$in);

	foreach $i (0 .. $#in) {
		# Convert plus's to spaces
		$in[$i] =~ s/\+/ /g; 

		# Split into key and value.
		($key, $val) = split(/=/,$in[$i],2);          # splits on the first =.

		# Convert %XX from hex numbers to alphanumeric
		$key =~ s/%(..)/pack("c",hex($1))/ge;
		$val =~ s/%(..)/pack("c",hex($1))/ge;

		# Associate key and value
		$in{$key} .= "\0" if (defined($in{$key}));    # \0 is the multiple separator
		$in{$key} .= $val;

	}

	return length($in); 
}