#!/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

Host:$host
Port:$port


EOP ### Spit out results in HTML # use qstat extracted data print ""; print ""; print ""; print "
Server title:$servername
Players:$players
Server max:$servermax
Map:$map


"; # Players print ""; print ""; for my $player_num ( 0 .. $numPlayers-1 ) { print ""; } # post for loop # print " nick: $nick[$_]\n " for 0 .. $numPlayers print "
NickTeamLagFrags
$nick[$player_num]team$team[$player_num]$lag[$player_num] ms$frags[$player_num]
"; 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";