line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
3
|
|
|
3
|
|
41185
|
use strict; |
|
3
|
|
|
|
|
3
|
|
|
3
|
|
|
|
|
65
|
|
2
|
3
|
|
|
3
|
|
8
|
use warnings; |
|
3
|
|
|
|
|
3
|
|
|
3
|
|
|
|
|
104
|
|
3
|
|
|
|
|
|
|
package Net::OTServ; |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
# ABSTRACT: Retrieve status information about Open Tibia Servers |
6
|
|
|
|
|
|
|
our $VERSION = '0.002'; # VERSION |
7
|
|
|
|
|
|
|
|
8
|
3
|
|
|
3
|
|
9
|
use Carp; |
|
3
|
|
|
|
|
3
|
|
|
3
|
|
|
|
|
183
|
|
9
|
3
|
|
|
3
|
|
1244
|
use IO::Socket; |
|
3
|
|
|
|
|
46266
|
|
|
3
|
|
|
|
|
8
|
|
10
|
3
|
|
|
3
|
|
2280
|
use IO::Socket::Timeout; |
|
3
|
|
|
|
|
12576
|
|
|
3
|
|
|
|
|
13
|
|
11
|
3
|
|
|
3
|
|
1224
|
use XML::Hash::XS; |
|
3
|
|
|
|
|
2000
|
|
|
3
|
|
|
|
|
471
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=pod |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=encoding utf8 |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 NAME |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
Net::OTServ - Retrieve status information about Open Tibia Servers |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 SYNOPSIS |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
use Net::OTServ; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
my $status = Net::OTServ::status("127.0.0.1", 7171); |
27
|
|
|
|
|
|
|
print "We got $status->{players}{online} players online!\n" |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 DESCRIPTION |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
Open Tibia servers offer a XML interface to query online count, client version and other information. |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 METHODS AND ARGUMENTS |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=over 4 |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=item status($ip [, $port]) |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
Retrieves the status of specified OTServ as a hash reference. If C<$port> is omitted, the default 7171 is assumed. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=cut |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub status { |
45
|
5
|
|
|
5
|
1
|
1051560
|
my $ip = shift; |
46
|
5
|
|
100
|
|
|
26
|
my $port = shift || 7171; |
47
|
|
|
|
|
|
|
|
48
|
5
|
100
|
|
|
|
51
|
my $ot = IO::Socket::INET->new( |
49
|
|
|
|
|
|
|
PeerAddr => $ip, |
50
|
|
|
|
|
|
|
PeerPort => $port, |
51
|
|
|
|
|
|
|
Proto => 'tcp', |
52
|
|
|
|
|
|
|
Timeout => 1, |
53
|
|
|
|
|
|
|
) or croak "OTServ at $ip:$port is offline."; |
54
|
|
|
|
|
|
|
|
55
|
3
|
|
|
|
|
356846
|
$ot->write("\x06\x00\xFF\xFF\x69\x6E\x66\x6F"); |
56
|
3
|
|
|
|
|
329
|
my $xml; $ot->recv($xml,1024); |
|
3
|
|
|
|
|
42
|
|
57
|
3
|
50
|
|
|
|
227925
|
$xml or croak "Server at $ip:$port doesn't reply."; |
58
|
3
|
|
|
|
|
7
|
my $status; eval { $status = xml2hash $xml }; |
|
3
|
|
|
|
|
11
|
|
|
3
|
|
|
|
|
490
|
|
59
|
3
|
100
|
66
|
|
|
68
|
$status and !$@ |
60
|
|
|
|
|
|
|
or croak "Server at $ip:$port doesn't reply in XML."; |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
|
63
|
2
|
|
|
|
|
234
|
return $status; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
1; |
69
|
|
|
|
|
|
|
__END__ |