File Coverage

blib/lib/WWW/Opentracker/Stats/Mode/Peer.pm
Criterion Covered Total %
statement 13 13 100.0
branch 1 2 50.0
condition n/a
subroutine 4 4 100.0
pod 1 1 100.0
total 19 20 95.0


line stmt bran cond sub pod time code
1             package WWW::Opentracker::Stats::Mode::Peer;
2              
3 1     1   24781 use strict;
  1         2  
  1         44  
4 1     1   5 use warnings;
  1         2  
  1         34  
5              
6 1         5 use parent qw/
7             WWW::Opentracker::Stats::Mode
8             Class::Accessor::Fast
9 1     1   844 /;
  1         294  
10              
11              
12             __PACKAGE__->_format('txt');
13             __PACKAGE__->_mode('peer');
14              
15             __PACKAGE__->mk_accessors(qw/_stats/);
16              
17              
18             =head1 NAME
19              
20             WWW::Opentracker::Stats::Mode::Peer
21              
22             =head1 DESCRIPTION
23              
24             Parses the Peer statistics from opentracker.
25              
26             =head1 METHODS
27              
28             =head2 parse_stats
29              
30             Args: $self, $payload
31              
32             Decodes the plain text data retrieved from the peer statistics of opentracker.
33              
34             The payload looks like this (no indentation):
35             3
36             3
37             opentracker serving 2 torrents
38             opentracker
39              
40             =cut
41              
42             sub parse_stats {
43 2     2 1 5 my ($self, $payload) = @_;
44              
45             # To support thousand delimiters
46 2 50       21 my ($raw_peers, $raw_seeds, $raw_torrents) = $payload =~ m{\A
47             ([\d\'\.]+) \s
48             ([\d\'\.]+) \s
49             opentracker \s serving \s ([\d\'\.]+) \s torrents \s
50             opentracker
51             }xms
52             or die "Unable to parse payload: $payload";
53              
54 2         13 my %stats = (
55             'peers' => $self->parse_thousands($raw_peers),
56             'seeds' => $self->parse_thousands($raw_seeds),
57             'torrents' => $self->parse_thousands($raw_torrents),
58             );
59              
60 2         36 return \%stats;
61             }
62              
63              
64             =head1 SEE ALSO
65              
66             L
67              
68             =head1 AUTHOR
69              
70             Knut-Olav Hoven, Eknutolav@gmail.comE
71              
72             =head1 COPYRIGHT AND LICENSE
73              
74             Copyright (C) 2009 by Knut-Olav Hoven
75              
76             This library is free software; you can redistribute it and/or modify
77             it under the same terms as Perl itself, either Perl version 5.8.8 or,
78             at your option, any later version of Perl 5 you may have available.
79              
80              
81             =cut
82              
83             1;
84