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

diff --git a/src/Modules/BZFlag.pl b/src/Modules/BZFlag.pl
index 1ef0887d92b573c923e48abbc3534057d2dc01b3..6c27a4d5b5edd7d8885f1d537f2ab368a305e49b 100755 (executable)
--- 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;