File Coverage

blib/lib/Net/Gnutella/Packet/Pong.pm
Criterion Covered Total %
statement 12 51 23.5
branch 0 14 0.0
condition n/a
subroutine 4 10 40.0
pod 0 5 0.0
total 16 80 20.0


line stmt bran cond sub pod time code
1             package Net::Gnutella::Packet::Pong;
2 1     1   5 use Socket qw(inet_ntoa inet_aton);
  1         1  
  1         273  
3 1     1   14 use Carp;
  1         3  
  1         62  
4 1     1   5 use strict;
  1         2  
  1         36  
5 1     1   4 use vars qw/$VERSION $AUTOLOAD/;
  1         2  
  1         782  
6            
7             $VERSION = $VERSION = "0.1";
8            
9             # Use AUTOHANDLER to supply generic attribute methods
10             #
11             sub AUTOLOAD {
12 0     0     my $self = shift;
13 0           my $attr = $AUTOLOAD;
14 0           $attr =~ s/.*:://;
15 0 0         return unless $attr =~ /[^A-Z]/; # skip DESTROY and all-cap methods
16 0 0         croak sprintf "invalid attribute method: %s->%s()", ref($self), $attr unless exists $self->{_attr}->{lc $attr};
17 0 0         $self->{_attr}->{lc $attr} = shift if @_;
18 0           return $self->{_attr}->{lc $attr};
19             }
20            
21             sub new {
22 0     0 0   my $proto = shift;
23 0           my %args = @_;
24            
25 0           my $self = {
26             _attr => {
27             msgid => [],
28             ttl => 7,
29             hops => 1,
30             function => 1,
31            
32             ip => [],
33             port => 0,
34             count => 0,
35             size => 0,
36             },
37             };
38            
39 0           bless $self, $proto;
40            
41 0           foreach my $key (keys %args) {
42 0           my $lkey = lc $key;
43            
44 0           $self->$lkey($args{$key});
45             }
46            
47 0           return $self;
48             }
49            
50             sub ip {
51 0     0 0   my $self = shift;
52            
53 0 0         if (@_) {
54 0 0         if (ref($_[0]) eq 'ARRAY') {
    0          
    0          
55 0           $self->{_attr}->{ip} = $_[0];
56             } elsif ($_[0] =~ /^[\d.]+$/) {
57 0           $self->{_attr}->{ip} = [ split(/\./, $_[0]) ];
58             } elsif ($_[0] =~ /\D/) {
59 0           $self->{_attr}->{ip} = [ split(/\./, inet_ntoa(inet_aton($_[0]))) ];
60             }
61             }
62            
63 0           return @{ $self->{_attr}->{ip} };
  0            
64             }
65            
66             sub ip_as_string {
67 0     0 0   my $self = shift;
68            
69 0           return join('.', @{ $self->{_attr}->{ip} });
  0            
70             }
71            
72             sub parse {
73 0     0 0   my $self = shift;
74 0           my $data = shift;
75            
76 0           my $port = unpack("S", substr($data, 0, 2));
77 0           my @ip = unpack("C4", substr($data, 2, 4));
78 0           my $count= unpack("L", substr($data, 6, 4));
79 0           my $size = unpack("L", substr($data, 10, 4));
80            
81 0           $self->port($port);
82 0           $self->ip(\@ip);
83 0           $self->count($count);
84 0           $self->size($size);
85             }
86            
87             sub format {
88 0     0 0   my $self = shift;
89            
90 0           my $data = pack("SC4LL", $self->port, $self->ip, $self->count, $self->size);
91            
92 0           return $data;
93             }
94            
95             1;