BZFlag-Info
view release on metacpan or search on metacpan
$ua->timeout(10);
my $req = HTTP::Request->new('GET', ($options{Server} ? $options{Server} : $self->listserver));
my $res = $ua->request($req);
my $totalServers = 0;
my $totalPlayers = 0;
for my $line (split("\n",$res->content)) {
my ($serverport, $version, $flags, $ip, $description) = split(" ",$line,5);
my @fields = ('style','maxShots','shakeWins','shakeTimeout','maxPlayerScore',
'maxTeamScore','maxTime','maxPlayers','rogueSize','rogueMax','redSize',
'redMax','greenSize','greenMax','blueSize','blueMax','purpleSize',
'purpleMax','observerSize','observerMax'
);
my @info = unpack("(A4)7 (A2)13", $flags);
my $counter = 0;
my %info;
$response->{servers}->{$serverport}->{roguesize} = $info{rogueSize};
$response->{servers}->{$serverport}->{redsize} = $info{redSize};
$response->{servers}->{$serverport}->{greensize} = $info{greenSize};
$response->{servers}->{$serverport}->{bluesize} = $info{blueSize};
$response->{servers}->{$serverport}->{purplesize} = $info{purpleSize};
$response->{servers}->{$serverport}->{observersize} = $info{observerSize};
$response->{servers}->{$serverport}->{serverconfig}->{style} = $self->parsestyle($info{style});
$response->{servers}->{$serverport}->{serverconfig}->{maxshots} = $info{maxShots};
$response->{servers}->{$serverport}->{serverconfig}->{shakewins} = $info{shakeWins};
$response->{servers}->{$serverport}->{serverconfig}->{shaketimeout} = $info{shakeTimeout} / 10;
$response->{servers}->{$serverport}->{serverconfig}->{maxplayerscore} = $info{maxPlayerScore};
$response->{servers}->{$serverport}->{serverconfig}->{maxteamscore} = $info{maxTeamScore};
$response->{servers}->{$serverport}->{serverconfig}->{maxtime} = $info{maxTime};
$response->{servers}->{$serverport}->{serverconfig}->{maxplayers} = $info{maxPlayers};
$response->{servers}->{$serverport}->{serverconfig}->{roguemax} = $info{rogueMax};
$response->{servers}->{$serverport}->{serverconfig}->{redmax} = $info{redMax};
$response->{servers}->{$serverport}->{serverconfig}->{greenmax} = $info{greenMax};
$response->{servers}->{$serverport}->{serverconfig}->{bluemax} = $info{blueMax};
$response->{servers}->{$serverport}->{serverconfig}->{purplemax} = $info{purpleMax};
$response->{servers}->{$serverport}->{serverconfig}->{observermax} = $info{observerMax};
sub queryserver(%) {
my $self = shift;
my %options;
while (my @option = splice(@_, 0, 2)) {
$options{$option[0]} = $option[1];
}
my $hostandport = $options{Server};
my $timeout = $options{Timeout};
my @teamName = ("X", "R", "G", "B", "P", "O", "H");
# my @teamName = ("X", "R", "G", "B", "P");
my ($message, $server);
my $response;
my ($servername, $port) = split(/:/, $hostandport);
$port = 5154 unless $port;
# socket define
my $sockaddr = 'S n a4 x8';
# get reply
unless (read(S, $buffer, 40) == 40) {
$self->{error} = 'errServerReadError';
return undef;
}
my ($infolen,$infocode,$style,$maxPlayers,$maxShots,
$rogueSize,$redSize,$greenSize,$blueSize,$purpleSize,
$rogueMax,$redMax,$greenMax,$blueMax,$purpleMax,
$shakeWins,$shakeTimeout,
$maxPlayerScore,$maxTeamScore,$maxTime) = unpack("n20", $buffer);
unless ($infocode == 0x7167) {
$self->{error} = 'errBadServerData';
return undef;
}
$response->{serverconfig}->{style} = $self->parsestyle($style);
$response->{serverconfig}->{maxplayers} = $maxPlayers;
$response->{serverconfig}->{maxshots} = $maxShots;
$response->{serverconfig}->{roguemax} = $rogueMax;
$response->{serverconfig}->{redmax} = $redMax;
$response->{serverconfig}->{greenmax} = $greenMax;
$response->{serverconfig}->{bluemax} = $blueMax;
$response->{serverconfig}->{purplemax} = $purpleMax;
$response->{serverconfig}->{shakewins} = $shakeWins;
$response->{serverconfig}->{shaketimeout} = $shakeTimeout;
$response->{serverconfig}->{maxplayerscore} = $maxPlayerScore;
$response->{serverconfig}->{maxteamscore} = $maxTeamScore;
$response->{serverconfig}->{maxtime} = $maxTime;
# send players request
print S pack("n2", 0, 0x7170);
# get number of teams and players we'll be receiving
unless (read(S, $buffer, 8) == 8) {
$self->{error} = 'errCountReadError';
( run in 0.596 second using v1.01-cache-2.11-cpan-fd5d4e115d8 )