#!/usr/bin/env perl
# Author: prg318
# June 06 2011
# Simple script to spit out warsow server details from qstat
# Dependencies: qstat > 2.11 (using svn revision367)

### Disclaimer:  I don't claim to grok perl that well.  This is the one of the first scripts
###              that I've written.  Feel free to hate.  I look forward to learning a lot
###              more about Perl into the future.  Cuz its sexy.
###
###              bacon<3
###

use Data::Dumper;
use Apache2::RequestUtil ();
use URI::Escape;

my $r = Apache2::RequestUtil->request();
my $args = $r->args();

my $host = "xannode.com";
my $port = 44400;
my $printQstat = ( $args =~ m/qstat/ ) ? 1 : 0;

# take an optional ?host= argument
if ($args =~ /host=(\w.*)/)
{
  $host = $1;
}

$host = uri_escape($host);

# preprend this before evertyhing so print debugging doesn't screw up output
print "Content-type: text/html\n\n";
$status = `qstat -P -warsows $host:$port`;
my $players;
my $servermax;
my $map;
my $servername;
# use regex to extract data from qstat output into variables
#                PLAYERS    MAX               MAP (rspns time)  NAME             
if ($status =~ /(\d\d|\d)\/(\d\d|\d) +\d\/\d +(\w+) +\d+ \/ \d +(\w.*)/)
{
  $players = $1;
  $servermax = $2;
  $map = $3;
  ($servername = $4) =~ s/^Warsow //;
}
else
{
	#die("Couldn't parse the qstat");
  print("<h1>Looks like the server is down, or you mispelled it.</h1>");
  exit;
}
# for each through this for players after splitting status string
#if ($status =~ /\n\s+(\d+)/m)
my @lines = split /\n/, $status;
my $len = @lines;
my @frags = ();
my @team = ();
my @lag = ();
my @nick = ();
my $numPlayers = 0;

# iterate through players
# start iteration at 2; first two lines are header and server info
#for(my $i=2; $i < $len ; $i++)
for my $line (@lines[2 .. $#lines])
{
  if ($line =~ /(\d+) frags team\#(\d)\s+(\d+)ms\s+(.+)/m)
  {
    my $frag = $1;
    my $t = $2;
    my $l = $3;
    my $strippedNick = $4;
    # print "$1\n$2\n$3\n$4\n"; # DEBUG
    if ($frag == 9999)
    {
      $frag = "spectator";
    }
    $strippedNick =~ s/\^\d//g;
    
    push (@frags, $frag);
    push (@team , $t);
    push (@lag , $l);
    push (@nick , $strippedNick);
    $numPlayers++;
  }
}

# General server info
print <<"EOP";
<html><head><title>Warsow Status</title></head><body>
<h1>Warsow Server Status</h1>
<table border><tr><td>Host:</td><td>$host</td></td>
<tr><td>Port:</td><td>$port</td></tr></table><br><br>
EOP

### Spit out results in HTML
# use qstat extracted data
print "<table border><tr><td>Server title:</td><td>$servername</td></tr>";
print "<tr><td>Players:</td><td>$players</td></tr>";
print "<tr><td>Server max:</td><td>$servermax</td></tr>";
print "<tr><td>Map:</td><td>$map</td></tr></table><br><br>";
# Players
print "<table border>";
print "<tr><td><b>Nick</b></td><td><b>Team</b></td><td><b>Lag</b></td><td><b>Frags</b></td></tr>";
for my $player_num ( 0 .. $numPlayers-1 )
{
  print "<tr><td>$nick[$player_num]</td><td>team$team[$player_num]</td><td>$lag[$player_num] ms</td><td>$frags[$player_num]</td></tr>";
}

# post for loop
# print " nick: $nick[$_]\n " for 0 .. $numPlayers

print "</table>";

if($printQstat)
{
  # print the raw qstat (isn't neccessary anymore but)
  #convert qstat data to html friendly data
  $status =~ s/\n/<br>/g;
  $status =~ s/ /&nbsp/g;
  print "<br>raw qstat:";
  print "<table border><td><code>";
  print $status;
  print "</code></td></table>";
}

#  print "<br>urmom:";
#  print "<table border><td><code>";
#  print Dumper(\%args);
#  print "</code></td></table>";
print "<p><a href='../'>back</a> | <a href='javascript:location.reload(true)'>refresh status</a></p>";
print "<h5>powered by perl</h5>";
print "</body></html>\n";

