#!/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("Looks like the server is down, or you mispelled it.
");
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";
Warsow Status
Warsow Server Status
EOP
### Spit out results in HTML
# use qstat extracted data
print "| Server title: | $servername |
";
print "| Players: | $players |
";
print "| Server max: | $servermax |
";
print "| Map: | $map |
";
# Players
print "";
print "| Nick | Team | Lag | Frags |
";
for my $player_num ( 0 .. $numPlayers-1 )
{
print "| $nick[$player_num] | team$team[$player_num] | $lag[$player_num] ms | $frags[$player_num] |
";
}
# post for loop
# print " nick: $nick[$_]\n " for 0 .. $numPlayers
print "
";
if($printQstat)
{
# print the raw qstat (isn't neccessary anymore but)
#convert qstat data to html friendly data
$status =~ s/\n/
/g;
$status =~ s/ / /g;
print "
raw qstat:";
print "";
print $status;
print " |
";
}
# print "
urmom:";
# print "";
# print Dumper(\%args);
# print " |
";
print "back | refresh status
";
print "powered by perl
";
print "\n";