File Coverage

blib/lib/Net/Gnutella/Packet/Push.pm
Criterion Covered Total %
statement 12 52 23.0
branch 0 14 0.0
condition n/a
subroutine 4 10 40.0
pod 0 5 0.0
total 16 81 19.7


line stmt bran cond sub pod time code
1             package Net::Gnutella::Packet::Push;
2 1     1   6 use Socket qw(inet_aton inet_ntoa);
  1         2  
  1         54  
3 1     1   5 use Carp;
  1         1  
  1         46  
4 1     1   5 use strict;
  1         1  
  1         60  
5 1     1   12 use vars qw/$VERSION $AUTOLOAD/;
  1         2  
  1         695  
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 => 64,
31            
32             guid => [],
33             index => 0,
34             ip => [],
35             port => 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 @guid = unpack("L4", substr($data, 0, 16, ''));
77 0           my $index = unpack("L", substr($data, 0, 4, ''));
78 0           my @ip = unpack("C4", substr($data, 0, 4, ''));
79 0           my $port = unpack("S", substr($data, 0, 2, ''));
80            
81 0           $self->guid(\@guid);
82 0           $self->index($index);
83 0           $self->ip(\@ip);
84 0           $self->port($port);
85             }
86            
87             sub format {
88 0     0 0   my $self = shift;
89            
90 0           my $data = pack("L4LC4S", @{ $self->guid }, $self->index, $self->ip, $self->port);
  0            
91            
92 0           return $data;
93             }
94            
95             1;