File Coverage

blib/lib/Net/OTServ.pm
Criterion Covered Total %
statement 34 34 100.0
branch 5 6 83.3
condition 4 5 80.0
subroutine 7 7 100.0
pod 1 1 100.0
total 51 53 96.2


line stmt bran cond sub pod time code
1 2     2   81405 use strict;
  2         5  
  2         45  
2 2     2   8 use warnings;
  2         3  
  2         78  
3             package Net::OTServ;
4              
5             # ABSTRACT: Retrieve status information about Open Tibia Servers
6             our $VERSION = '0.004'; # VERSION
7              
8 2     2   9 use Carp;
  2         4  
  2         106  
9 2     2   433 use IO::Socket;
  2         15679  
  2         9  
10 2     2   1494 use IO::Socket::Timeout;
  2         7221  
  2         11  
11 2     2   735 use XML::Hash::XS;
  2         1399  
  2         397  
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 4     4 1 1046592 my $ip = shift;
46 4   100     38 my $port = shift || 7171;
47 4         20 my $timeout = 1;
48              
49 4 100       79 my $ot = IO::Socket::INET->new(
50             PeerAddr => $ip,
51             PeerPort => $port,
52             Proto => 'tcp',
53             Timeout => $timeout, # connection timeout
54             ) or croak "OTServ at $ip:$port is offline.";
55 2         138305 IO::Socket::Timeout->enable_timeouts_on($ot);
56 2         547 $ot->read_timeout($timeout);
57 2         233 $ot->write_timeout($timeout);
58              
59 2         120 $ot->write("\x06\x00\xFF\xFF\x69\x6E\x66\x6F");
60 2         151 my $xml; $ot->recv($xml, 1500);
  2         20  
61 2 50       84550 $xml or croak "Server at $ip:$port doesn't reply.";
62 2         7 my $status; eval { $status = xml2hash $xml };
  2         10  
  2         289  
63 2 100 66     60 $status and !$@
64             or croak "Server at $ip:$port doesn't reply in XML.";
65              
66            
67 1         50 return $status;
68             }
69              
70              
71              
72             1;
73             __END__