File Coverage

blib/lib/Net/Gnutella/Packet/Reply.pm

Criterion	Covered	Total	%
statement	12	77	15.5
branch	0	18	0.0
condition			n/a
subroutine	4	10	40.0
pod	0	5	0.0
total	16	110	14.5

package Net::Gnutella::Packet::Reply;
use Socket qw(inet_ntoa inet_aton);
use Carp;
use strict;
use vars qw/$VERSION $AUTOLOAD/;

$VERSION = $VERSION = "0.1";

# Use AUTOHANDLER to supply generic attribute methods
#
sub AUTOLOAD {
	my $self = shift;
	my $attr = $AUTOLOAD;
	$attr =~ s/.*:://;
	return unless $attr =~ /[^A-Z]/; # skip DESTROY and all-cap methods
	croak sprintf "invalid attribute method: %s->%s()", ref($self), $attr unless exists $self->{_attr}->{lc $attr};
	$self->{_attr}->{lc $attr} = shift if @_;
	return $self->{_attr}->{lc $attr};
}

sub new {
	my $proto = shift;
	my %args = @_;

	my $self = {
		_attr   => {
			msgid    => [],
			ttl      => 7,
			hops     => 1,
			function => 129,

			ip      => [],
			port    => 0,
			speed   => 0,
			results => [],
			guid    => [],
		},
	};

	bless $self, $proto;

	foreach my $key (keys %args) {
		my $lkey = lc $key;

		$self->$lkey($args{$key});
	}

	return $self;
}

sub ip {
	my $self = shift;

	if (@_) {
		if (ref($_[0]) eq 'ARRAY') {
			$self->{_attr}->{ip} = $_[0];
		} elsif ($_[0] =~ /^[\d.]+$/) {
			$self->{_attr}->{ip} = [ split(/\./, $_[0]) ];
		} elsif ($_[0] =~ /\D/) {
			$self->{_attr}->{ip} = [ split(/\./, inet_ntoa(inet_aton($_[0]))) ];
		}
	}

	return @{ $self->{_attr}->{ip} };
}

sub ip_as_string {
	my $self = shift;

	return join(".", @{ $self->{_attr}->{ip} });
}

sub parse {
	my $self = shift;
	my $data = shift;

	my $count = unpack("C",  substr($data, 0, 1, ''));
	my $port  = unpack("S",  substr($data, 0, 2, ''));
	my @ip    = unpack("C4", substr($data, 0, 4, ''));
	my $speed = unpack("L",  substr($data, 0, 4, ''));
	my @set;

	for (my $i = 0; $i < $count; $i++) {
		my $index = unpack("L", substr($data, 0, 4, ''));
		my $size  = unpack("L", substr($data, 0, 4, ''));
		my $name  = substr($data, 0, index($data, "\x00\x00"), '');
		my $extra;

		if (index($name, "\x00") != -1) {
			$extra = $name;
			$name  = substr($extra, 0, index($extra, "\x00"), '');

			substr($extra, 0, 1, '');
		}

		substr($data, 0, 2, '');

		push @set, [ $index, $size, $name, $extra ];
	}

	my @guid = unpack("L4", substr($data, 0, 16, ''));

	$self->port($port);
	$self->ip(\@ip);
	$self->speed($speed);
	$self->results(\@set);
	$self->guid(\@guid);
}

sub format {
	my $self = shift;
	my $data;

	my $results = $self->results;

	$data .= pack("C",  scalar @$results);
	$data .= pack("S",  $self->port);
	$data .= pack("C4", $self->ip);
	$data .= pack("L",  $self->speed);

	foreach my $res (@$results) {
		$data .= pack("L", $res->[0]);
		$data .= pack("L", $res->[1]);
		$data .= $res->[2];
		$data .= $data =~ /\x00\x00$/ ? "" : "\x00\x00";
	}

	$data .= pack("L4", @{ $self->guid });

	return $data;
}

1;