#!/usr/bin/perl
#
#BF1942Live v3.0
#
#Code by Lt.Christy - http://www.force137.com - christy@force137.com
#
# DEPRECATED - #Qstat Module - http://www.qstat.org
# qstat.pm included in file
#
####################################################################
# Configure Stats
####################################################################

########
#Server IP and Port: For the Port, just add 8433 onto the value of your port. If you use the default
#port of 14567 then you would put in 23000
########
my $server = '207.44.182.44:23000';

########
#Border Color of the Stats
########
my $bordercolor = '#000000';

########
#Top and Bottom Cell Colors
########
my $topbottomcell = '#000000';

########
#Page Background Color
########
my $backgroundcolor = '#ffffff';

########
#Server Admin Name, will show as red on the playerlist, or Use serveradmintag to highlight
#anyone with that tag, must escape regexp chars ([,.{( and so on)
########
my $serveradmin = 'LA_MERC_Onji';
my $serveradmintag = 'LA_MERC';

########
#Page Refresh Rate in Seconds
########
my $refreshrate = '8';

########
#Font Color
########
my $fontcolor = '#000000';

########
#Number of Ping to be know as a Lagger, Anything above this number will be marked
########
my $lagger = '250';

########
#Your Webpage/Serverpage URL
########
my $weburl = 'http://www.lamerc.com';

########
#Mark 1 if using your own Logo in the stats, or 0 if not. Do not make your image wider than 800
#pixels or it will make the table look funny :)
########
my $usetitlepic = '0';

########
#If Using your own logo, specify location
########
my $titlepic = 'http://www.force137.com/stats/bf1942live/images/bflivelogo.jpg';

########
#If Using your own logo, specify alignment (left, center, right)
########
my $align = 'left';

########
#If Using your own logo, specify color behind your Logo
########
my $titlepicbg = '#000000';

########
#Colors for Laggers, Admin, and Teamkiller
########
my $laggercolor = '#92BDFE';
my $admincolor = '#FB0A04';
my $teamkillercolor = '#F5FE04';

########
#Colors for Player Count if Server is Full or if Server has an Open Slot
########
my $servernotfullcolor = '#00ff00';
my $serverfullcolor = '#FB0A04';


####################################################################
# End of Configure Stats
####################################################################






### DO NOT EDIT BELOW THIS LINE UNLESS YOU KNOW WHAT YOU ARE DOING ###


use strict;
use CGI qw(-no_debug);
$! = 1;
my $q = new CGI;

my @sortedplayers = ();
my @frags = ();
my @sortedfrags = ();
my %serverdata = ();
my %rules = ();
my $now = localtime;

my ($generalline,$rulesline,@playerlines);
my ($s, $p) = split( /:/, $server );
if ( qstat::query( $s, $p, \@playerlines ) ) {
    $generalline = shift @playerlines;
    $rulesline = shift @playerlines; 
} else {
    $generalline = "DOWN::DOWN::DOWN"; # use TIMEOUT if we want the "busy" message...
}

# Split general and rules info into seperate variables
my @general = split(/::/,$generalline);
$serverdata{"ip"}   = $general[1];
$serverdata{"name"} = $general[2];
$serverdata{"map"}  = $general[3];
$serverdata{"max"}  = $general[4];
$serverdata{"plyrs"}= $general[5];
$serverdata{"ping"} = $general[6];
$serverdata{"tout"} = $general[7];

# Split unknown amount of rules into name/value pairs.
for(split '::', $rulesline) 
{
    if (my($var_name, $var_value) = split /=/) 
    {
	$rules{$var_name} = $var_value;
    }
}

# Is the server unreachable?
if ($serverdata{"name"} eq 'DOWN') 
{

print "Content-type: text/html\r\n\r\n";

print <<STATE;

<html>

<head>
<meta http-equiv="refresh" content="$refreshrate">
<meta http-equiv="pragma" content="no-cache">
<title>$serverdata{name} Live View</title>



</head>

<body topmargin="0" leftmargin="0" marginheight="0" marginwidth="0"
bgcolor=$backgroundcolor
 link="$fontcolor" vlink="$fontcolor" alink="$fontcolor">

<center><br><br><br><table align="center" border="1" width="300" height="100" bordercolor="$bordercolor" style="border-collapse: collapse"><tr><td align="center" valign="middle"><font color="$fontcolor" size=2 face=verdana>Server is Down</font></td></tr></center></table>
</body>

</html>



STATE


} 
elsif ($serverdata{"name"} eq 'TIMEOUT') 
{

print "Content-type: text/html\r\n\r\n";

print <<STATE;

<html>

<head>
<meta http-equiv="refresh" content="$refreshrate">
<meta http-equiv="pragma" content="no-cache">
<title>$serverdata{name} Live View</title>
</head>

<body topmargin="0" leftmargin="0" marginheight="0" marginwidth="0"
bgcolor=$backgroundcolor
 link="$fontcolor" vlink="$fontcolor" alink="$fontcolor">

<center><br><br><br><table align="center" border="1" width="300" height="100" bordercolor="$bordercolor" style="border-collapse: collapse"><tr><td align="center" valign="middle"><font color="$fontcolor" size=2 face=verdana>Server is Busy, Please Refresh</font></td></tr></center></table>
</body>

</html>



STATE




}

else
{

# Some default settings:
$rules{fraglimit} = $rules{fraglimit} == 0 ? $rules{fraglimit} = 'None' : $rules{fraglimit};
$rules{dmflags} = $rules{dmflags} == 0 ? $rules{dmflags} = 'Default' : $rules{dmflags};
$rules{timelimit} = $rules{timelimit} == 0 ? $rules{timelimit} = 'None' : $rules{timelimit};
$serverdata{limit} = $rules{fraglimit};
$serverdata{limitname} = "Fraglimit";

# Split player info:
my (@data,$index);
for(0 .. $#playerlines) 
{
    @data = split(/::/,$playerlines[$_],3);
    $frags[$_] = $data[1] . ".$_";
}

@sortedfrags = sort {$b <=> $a} @frags;

for(0 .. $#sortedfrags) 
{
    @data = split(/\./,$sortedfrags[$_]);
    $index = $data[1];
    push (@sortedplayers, $playerlines[$_]);
}

# Print out what we found:

print "Content-type: text/html\r\n\r\n";

print <<STATE;

<html>

<head>
<meta http-equiv="refresh" content="$refreshrate">
<meta http-equiv="pragma" content="no-cache">
<title>$serverdata{name} Live View</title>

<script language="javascript">
var win = null;
function NewWindow(mypage,myname,w,h,scroll,resize){
LeftPosition = (screen.width) ? (screen.width-w)/2 : 0;
TopPosition = (screen.height) ? (screen.height-h)/2 : 0;
settings =
'height='+h+',width='+w+',top='+TopPosition+',left='+LeftPosition+',scrollbars='+scroll+',resizable='+resize+''
win = window.open(mypage,myname,settings)
}

</script>

</head>

<body topmargin="0" leftmargin="0" marginheight="0" marginwidth="0"
bgcolor=$backgroundcolor
 link="$fontcolor" vlink="$fontcolor" alink="$fontcolor">


<div align="center">
  <center>
<br><br>
  <table border="1" cellpadding="1" cellspacing="0" style="border-collapse: collapse" width="800" id="AutoNumber1" bordercolor="$bordercolor">
STATE


if ($usetitlepic eq '1') 
{
print <<STATE;
    <tr><td width="100%" bgcolor="$topbottomcell" colspan="3"><b><font color="$fontcolor" size="2" face="verdana">&nbsp;</b></td></tr>
    <tr><td width="100%" bgcolor="$titlepicbg" colspan="3" align="$align" valign="bottom">
<img src="$titlepic">
</td></tr>
STATE
}



print <<STATE;

    <tr><td width="100%" bgcolor="$topbottomcell" colspan="3"><b><font color="$fontcolor" size="2" face="verdana">&nbsp;$serverdata{name}</b></td></tr>
<tr>
      <td width="34%" align="center" valign="top" height="40">
<table width="100%">
<tr><td valign="top">
STATE


if ($serverdata{plyrs} == $serverdata{max})
{

print <<EOF;

<font color="$serverfullcolor" face="Verdana,Helvetica" size="1"><b>&nbsp;$serverdata{plyrs}</b></font><font color="$fontcolor" face="Verdana,Helvetica" size="1"> out of </font><font color="$serverfullcolor" face="Verdana,Helvetica" size="1"><b>$serverdata{max}</b></font>

EOF
}
elsif (($serverdata{plyrs} < $serverdata{max}) && ($serverdata{plyrs} > 0 ))
{

print <<EOF;

<font color="$servernotfullcolor" face="Verdana,Helvetica" size="1"><b>&nbsp;$serverdata{plyrs}</b></font><font color="$fontcolor" face="Verdana,Helvetica" size="1"> out of </font><font color="$servernotfullcolor" face="Verdana,Helvetica" size="1"><b>$serverdata{max}</b></font>

EOF

}

else
{
print <<EOF;

<font color="$fontcolor" face="Verdana,Helvetica" size="1"><b>&nbsp;$serverdata{plyrs}</b></font><font color="$fontcolor" face="Verdana,Helvetica" size="1"> out of </font><font color="$fontcolor" face="Verdana,Helvetica" size="1"><b>$serverdata{max}</b></font>

EOF
}


print <<STATE;
<font color="$fontcolor" face="Verdana,Helvetica" size="1">
 players on map<b> 
$serverdata{map}
<br>&nbsp;</b>$now&nbsp;</font><br><br></td></tr>
<tr><td align="center" valign="top">
<a href="#" onclick="NewWindow('http://www.lamerc.com/images/mappics/$serverdata{map}_z.jpg','BF1942Live','550','600','yes');return false"><IMG SRC="http://www.lamerc.com/images/mappics/$serverdata{map}.jpg" width=240 height=291 alt="Click for Bigger Image"></a>
<br><font color="$fontcolor" face="Verdana,verdana,Helvetica" size="1"><b>
$serverdata{map}
</b></font>
</td></tr></table>
</td>
      <td width="36%" rowspan="1" align="left" valign="top">
STATE

if ($serverdata{plyrs} == 0)
{

print <<EOF;

<center><Font color="$fontcolor" size=1 Face='verdana'><b>No Players Connected</b></font></center>

EOF

}
else
{



my ($newplayer,@player);


print <<EOF;

	<TABLE width=100% border=0 cellspacing=0 cellpadding=1>
<TR><TD width='100%' colspan="5" bgcolor="#04397B"><font face='Verdana,Helvetica' size='1' color='#ffffff'><b>Allied Team</b>&nbsp;<img src=images/alliedflags.jpg></font></TD></tr>
	<TR><TD width="60%" ><Font color="$fontcolor" size=1 Face='verdana'><b><u>Players</b></u></TD>
	<TD width="10%" align="center"><Font color="$fontcolor" size=1 Face='verdana'><b><u>Score</b></u></TD>
	<TD width="10%" align="center"><Font color="$fontcolor" size=1 Face='verdana'><b><u>Frags</b></u></TD>
	<TD width="10%" align="center"><Font color="$fontcolor" size=1 Face='verdana'><b><u>Deaths</b></u></TD>
	<TD width="10%" align="center"><Font color="$fontcolor" size=1 Face='verdana'><b><u>Ping</b></u></TD>

EOF



    my $idcnt = 0;
    my $ping  = 0;
    my $frag  = 0;
    my $team  = 0;
    my $name  = '';
    my $rfrag = 0;
    my $death = 0;
    
    foreach $newplayer (@sortedplayers) 
    {
	@player = split(/::/,$newplayer);
	$name = CGI::escapeHTML( $player[0] );
	$frag = $player[1];
	$ping = $player[2];
	$team = $player[3];
	$rfrag= $player[4];
	$death= $player[5];

	$name =~ s/(^.5(?!$))(.*$)/$1.../g;

if ($team eq '2') 
{

if ($ping > $lagger) 
{

	print <<EOF;

<TR><TD width='60%'><font face='Verdana,Helvetica' size='1' color='$laggercolor'>$name</font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$frag </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$rfrag </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$death </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor'  face='Verdana,Helvetica' size='1'>$ping </font></TD></TR>


EOF

}
elsif (($name eq $serveradmin) || ($name =~ /$serveradmintag/)) 
{
	print <<EOF;

<TR><TD width='60%'><font face='Verdana,Helvetica' size='1' color='$admincolor'>$name</font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$frag </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$rfrag </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$death </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor'  face='Verdana,Helvetica' size='1'>$ping </font></TD></TR>


EOF

}

elsif ($frag < '0') 
{

	print <<EOF;

<TR><TD width='60%'><font face='Verdana,Helvetica' size='1' color='$teamkillercolor'>$name</font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$frag </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$rfrag </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$death </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor'  face='Verdana,Helvetica' size='1'>$ping </font></TD></TR>

EOF

}

else
{


	print <<EOF;

<TR><TD width='60%'><font face='Verdana,Helvetica' size='1' color='$fontcolor'>$name</font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$frag </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$rfrag </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$death </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor'  face='Verdana,Helvetica' size='1'>$ping </font></TD></TR>

EOF


}


}

    
    }

print <<EOF;
<TR><TD width='100%' colspan="5" height="20">&nbsp;</TD></tr>
<TR><TD width='100%' colspan="5" bgcolor="#970116"><font face='Verdana,Helvetica' size='1' color='#ffffff'><b>Axis Team</b>&nbsp;<img src=images/axisflags.jpg></font></TD></tr>
	<TR><TD width="60%" ><Font color="$fontcolor" size=1 Face='verdana'><b><u>Players</b></u></TD>
	<TD width="10%" align="center"><Font color="$fontcolor" size=1 Face='verdana'><b><u>Score</b></u></TD>
	<TD width="10%" align="center"><Font color="$fontcolor" size=1 Face='verdana'><b><u>Frags</b></u></TD>
	<TD width="10%" align="center"><Font color="$fontcolor" size=1 Face='verdana'><b><u>Deaths</b></u></TD>
	<TD width="10%" align="center"><Font color="$fontcolor" size=1 Face='verdana'><b><u>Ping</b></u></TD>

EOF



    my $idcnt = 0;
    my $ping  = 0;
    my $frag  = 0;
    my $team  = 0;
    my $name  = '';
    my $rfrag = 0;
    my $death = 0;
    
    foreach $newplayer (@sortedplayers) 
    {
	@player = split(/::/,$newplayer);
	$name = CGI::escapeHTML( $player[0] );
	$frag = $player[1];
	$ping = $player[2];
	$team = $player[3];
	$rfrag= $player[4];
	$death= $player[5];

	$name =~ s/(^.5(?!$))(.*$)/$1.../g;

if ($team eq '1') 
{

if ($ping > $lagger) 
{

	print <<EOF;

<TR><TD width='70%'><font face='Verdana,Helvetica' size='1' color='$laggercolor'>$name</font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$frag </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$rfrag </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$death </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor'  face='Verdana,Helvetica' size='1'>$ping </font></TD></TR>


EOF

}
elsif (($name eq $serveradmin) || ($name =~ /$serveradmintag/)) 
{
	print <<EOF;

<TR><TD width='70%'><font face='Verdana,Helvetica' size='1' color='$admincolor'>$name</font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$frag </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$rfrag </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$death </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor'  face='Verdana,Helvetica' size='1'>$ping </font></TD></TR>


EOF

}

elsif ($frag < '0') 
{

	print <<EOF;

<TR><TD width='70%'><font face='Verdana,Helvetica' size='1' color='$teamkillercolor'>$name</font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$frag </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$rfrag </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$death </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor'  face='Verdana,Helvetica' size='1'>$ping </font></TD></TR>

EOF

}

else
{


	print <<EOF;

<TR><TD width='70%'><font face='Verdana,Helvetica' size='1' color='$fontcolor'>$name</font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$frag </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$rfrag </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor' face='Verdana,Helvetica' size='1'>$death </font></TD>
<TD  width='10%' align='center'><font color='$fontcolor'  face='Verdana,Helvetica' size='1'>$ping </font></TD></TR>


EOF


}


}

    
    }


print <<EOF;
<TR><TD width='100%' colspan="5" height="20">&nbsp;</TD></tr>
</TD></TR>
</TABLE>
EOF
}
print <<EOF;
      </td>
      <td width="30%" rowspan="1" align="left" valign="top">
<table border="0" width="100%" cellspacing="0" cellpadding="0">
<tr>
<td><font color="$fontcolor" size="1" face="verdana"><b><u>Rules</u></b></font></td>
<td align="right"><font color="$fontcolor" size="1" face="verdana"><b><u>Setting</u></b></font></td>
</tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
Timelimit
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
$rules{"Time Limit"}
</td></tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
Gametype
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
$rules{gametype}
</td></tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
InfoSite
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
<a href="http://www.bfcentral.com/" target=_new>BFCentral.Com</a>
</td></tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
fraglimit
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
$rules{fraglimit}
</td></tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
gamemode
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
$rules{gamemode}
</td></tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
Dedicated
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
$rules{Dedicated}
</td></tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
CPU
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
$rules{CPU}
</td></tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
Allied Team Ratio
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
$rules{"Allied Team Ratio"}
</td></tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
Allow Nose Cam
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
$rules{"Allow Nose Cam"}
</td></tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
Auto Balance Teams
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
$rules{"Auto Balance Teams"}
</td></tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
Free Camera
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
$rules{"Free Camera"}
</td></tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
Game Start Delay
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
$rules{"Game Start Delay"}
</td></tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
Name Tag Distance
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
$rules{"Name Tag Distance"}
</td></tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
Number Of Rounds
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
$rules{"Number Of Rounds"}
</td></tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
Soldier Friendly Fire
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
$rules{"Soldier Friendly Fire"}
</td></tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
Spawn Delay
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
$rules{"Spawn Delay"}
</td></tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
Spawn Wave Time
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
$rules{"Spawn Wave Time"}
</td></tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
Ticket Ratio
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
$rules{"Ticket Ratio"}
</td></tr>
<tr><td><font color="$fontcolor" face="verdana" size="1">
Vehicle Friendly Fire
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
$rules{"Vehicle Friendly Fire"}
</td></tr>


<tr><td><font color="$fontcolor" face="verdana" size="1">
Server Website
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
<a href="$weburl">Visit Us</a>
</td></tr>

<tr><td><font color="$fontcolor" face="verdana" size="1">
BF1942Live
</td><td align="right"><font color="$fontcolor" face=verdana size=1>
<a href="http://www.force137.com/download.asp?id=284" target=_new>Version 3.0</a>
</td></tr>
</table>
</td>
      </td>
    </tr>
    <tr>
      <td align="left" bgcolor="$topbottomcell" bordercolor="$topbottomcell" valign="middle" colspan="1"><font color="$fontcolor" size=1 face =verdana>
      <b> Version: Battlefield 1942 $rules{gamever}</b></font>
</td>
      <td align="right" bgcolor="$topbottomcell" valign="middle" colspan="2"><font color="$fontcolor" size=1 face=verdana>
<b>Player Color Chart:</b>&nbsp;&nbsp;</font><font face="verdana" color="$teamkillercolor" size=1>Teamkiller/Selfkiller</font><font color="$fontcolor" size=1 face =verdana>&nbsp;-&nbsp;</font><font face="verdana" color="$admincolor" size=1>Admin</font><font color="$fontcolor" size=1 face =verdana>&nbsp;-&nbsp;</font><font face="verdana" color="$laggercolor" size=1>Lagging</font></td>
    </tr>

</table>

  </center>
</div>

</body>


EOF
print "</html>\n";
}

#!/usr/bin/perl -w
########################################################################
# $Id: qstat.pm,v 1.4 2003/02/21 16:58:51 jjlupa Exp $
########################################################################
#
# How to get around qstat.exe.  This module does direct querying of 
# a BF1942 host using the gamespy protocol.  Note that BF1942 doesn't
# really honor the protocol well, and often lies with regards to what
# is going on.  As such, information returned from here is of marginal
# use for logging, but is better than nothing.
#
# Interested in logging? check out http://lupavista.jamdata.net/bf1942
#
# All code (c) Jonathan Lupa (jjlupa@jamdata.net) released under BSD license
#
########################################################################

package qstat;

########################################################################
#
# INTERFACE:
#
# bool qstat::query( host_scalar, port_scalar, data_array_ref );
#
# if return != 0, data_array_ref is filled out with information simulating
# a call to qstat thusly: qstat -R -P -cn -tsw -gps $server -raw ::
#
########################################################################

use IO::Socket;
use strict;

sub query {
  
  (@_ == 3 ) || die "USAGE: qstat::query( host_scalar, port_scalar, data_array_ref )";
  my( $host, $port, $data_out ) = @_;
  
  @$data_out = ();
  
  # here is our socket...
  my $socket = IO::Socket::INET->new( Proto => 'udp', PeerPort => $port, PeerAddr => gethostbyname( $host ) )
    || die "socket creation failed: $@";
  
  # GET SERVER STATUS
  my $msg = "\\status\\";
  if ( $socket->send( $msg ) == 0 ) {
    return 0;
  }
  
  my $reply = undef;
  my @data = ();
  my ( $rin, $rout, $eout, $test );
  vec( $rin, fileno( $socket ), 1 ) = 1;

  while ( ! defined( $data[-4]) || $data[-4] ne "final" ) {
    if ( select( $rout = $rin, undef, $eout = $rin, 1 ) ) {
      $test = $socket->recv( $reply, 1024 * 8 );
    } else {
      return 0;
    }

    # remember to remove the first slash....
    $reply =~ s/\\//;
    push( @data, split( /\\/, $reply ) );
  }
  
  my( %teams, %scores, %names, %frags, %deaths, %pings, %teamnames, %global );
  
  while ( defined( my $key = shift( @data ) ) ) {
    my $value = shift( @data );
    
    # TEAMNAME HASHES THE TEAMS NAMES
    if ( $key =~ /teamname_(\d+)/ ) {
      my $teamnum = $1 + 1;
      $teamnames{$teamnum} = $value;
    }
    # THESE ARE PLAYER STATS
    elsif ( $key =~ /score_(\d+)/ ) {
      $scores{$1} = $value;
    } elsif ( $key =~ /team_(\d+)/ ) {
      $teams{$1} = $value;
    } elsif ( $key =~ /player_(\d+)/ ) {
      $names{$1} = $value;
    } elsif ( $key =~ /frags_(\d+)/ ) {
      $frags{$1} = $value;
    } elsif ( $key =~ /deaths_(\d+)/ ) {
      $deaths{$1} = $value;
    } elsif ( $key =~ /ping_(\d+)/ ) {
      $pings{$1} = $value;
    }
    # THESE ARE THROW AWAY VALUES
    elsif ( $key eq "queryid" ) {
    } elsif ( $key eq "final" ) {
    }
    # THESE ARE GLOBAL VALUES
    else {
      $global{$key}=$value;
    }
  }
  
  # BUILD LINE 1
  # GPS::twinkletwinkle:23000::298th Training Grounds::Gazala::40::38::61::0
  my $servername = $global{"hostname"};
  if ( scalar( keys( %global ) ) < 10 ) { $servername = "DOWN"; }
  my $line1 = "GPS::$host:$port" . "::"
  . $servername                  . "::" 
  . $global{"mapname"}           . "::"
  . $global{"maxplayers"}        . "::"
  . $global{"numplayers"}        . "::"
  . "60::0"; # who cares about ping
  
  push( @$data_out, $line1 );
  
  # BUILD LINE 2
  # Line 2 is the server rules
  my $line2 = "";
  foreach ( sort( keys( %global ) ) ) {
    $line2 = $line2 . "::";
    $line2 = $line2 . $_ . "=" . $global{$_};
  }
  
  foreach ( sort( keys( %teamnames ) ) ) {
    $line2 = $line2 . "::";
    $line2 = $line2 . $_ . "=" . $teamnames{$_};
  }
  
  push( @$data_out, $line2 );
  
  # BUILD LINE 3+
  # These are the players...  name::score::ping::team::::::
  # I'm adjusting thus:  name::score::ping::team::deaths::frags::
  foreach( keys( %names ) ) {
    push( @$data_out, "$names{$_}::$scores{$_}::$pings{$_}::$teams{$_}::$frags{$_}::$deaths{$_}::" );
  }
  
  return 1;
}

1;

