From d0c1db42ee42a7e692f9f8489441ff6d60fef1a8 Mon Sep 17 00:00:00 2001
From: timriker <timriker@c11ca15a-4712-0410-83d8-924469b57eb5>
Date: Wed, 17 Dec 2003 17:14:01 +0000
Subject: [PATCH] 1.10 support on list only
git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk/blootbot@904 c11ca15a-4712-0410-83d8-924469b57eb5
---
src/Modules/BZFlag.pl | 35 +++++++++++++++++++++++++++++++++++
1 file changed, 35 insertions(+)
diff --git a/src/Modules/BZFlag.pl b/src/Modules/BZFlag.pl
index 1ef0887..6c27a4d 100755
--- a/src/Modules/BZFlag.pl
+++ b/src/Modules/BZFlag.pl
@@ -47,6 +47,41 @@ sub BZFlag::list {
$ua->timeout(5);
+ my $req = HTTP::Request->new('GET', 'http://db.bzflag.org/db/?action=LIST');
+ my $res = $ua->request($req);
+ my %servers;
+ my $totalServers = 0;
+ my $totalPlayers = 0;
+ for my $line (split("\n",$res->content)) {
+ my ($serverport, $version, $flags, $ip, $comments) = split(" ",$line,5);
+ # not "(A4)18" to handle old dumb perl
+ my ($style, $maxShots, $shakeWins, $shakeTimeout, $maxPlayerScore, $maxTeamScore, $maxTime,
+ $maxPlayers, $rogueSize, $rogueMax, $redSize, $redMax, $greenSize, $greenMax,
+ $blueSize, $blueMax, $purpleSize, $purpleMax, $observerSize, $observerMax) =
+ unpack("A4A4A4A4A4A4A4A2A2A2A2A2A2A2A2A2A2A2A2A2", $flags);
+ my $playerSize = hex($rogueSize) + hex($redSize) + hex($greenSize)
+ + hex($blueSize) + hex($purpleSize) + hex($observerSize);
+ $servers{$serverport} = $playerSize;
+ $totalServers += 1;
+ $totalPlayers += $playerSize;
+ }
+ $response .= "s=$totalServers p=$totalPlayers";
+ foreach my $key (sort {$servers{$b} <=> $servers{$a}} (keys(%servers))) {
+ if ($servers{$key} > 0) {
+ $response .= " $key($servers{$key})";
+ }
+ }
+ &::performStrictReply($response);
+ return;
+}
+
+sub BZFlag::list17 {
+ my ($response);
+ my $ua = new LWP::UserAgent;
+ $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
+
+ $ua->timeout(5);
+
my $req = HTTP::Request->new('GET', 'http://list.bzflag.org:5156/');
my $res = $ua->request($req);
my %servers;
--
2.39.5