ipxwrapper/tests/lib/NetPacket/IPXWrapper.pm

use strict;
use warnings;

package NetPacket::IPXWrapper;
use parent qw(NetPacket);

use Carp;

sub new
{
	my ($class, %packet) = @_;
	
	foreach my $key(qw(type dest_network dest_node dest_socket
		src_network src_node src_socket data))
	{
		croak("Missing $key argument") unless(defined($packet{$key}));
	}
	
	croak("Invalid type argument")  unless($packet{type} =~ m/^\d+$/ && $packet{type} <= 255);
	
	_check_address("destination", $packet{dest_network}, $packet{dest_node}, $packet{dest_socket});
	_check_address("source",      $packet{src_network},  $packet{src_node},  $packet{src_socket});
	
	return bless(\%packet, $class);
}

sub _check_address
{
	my ($direction, $network, $node, $socket) = @_;
	
	my $OCTET = qr/[0-9A-F][0-9A-F]?/i;
	
	croak("Invalid $direction network") unless($network =~ m/^$OCTET(:$OCTET){3}$/);
	croak("Invalid $direction node")    unless($node =~ m/^$OCTET(:$OCTET){5}$/);
	croak("Invalid $direction socket")  unless($socket =~ m/^\d+$/ && $socket <= 65535);
}

#
# Decode the packet
#

sub decode
{
	my ($class, $pkt, $parent) = @_;
	
	my $self = bless({
		_parent => $parent,
		_frame  => $pkt,
	}, $class);
	
	if(defined($pkt))
	{
		# Use array slices to capture the appropriate number of bytes
		# from each address field.
		
		my (
			$type,
			@dst_network, @dst_node, $dst_socket,
			@src_network, @src_node, $src_socket,
			$length,
		);
		
		(
			$type,
			@dst_network[0..3], @dst_node[0..5], $dst_socket,
			@src_network[0..3], @src_node[0..5], $src_socket,
			$length,
		) = unpack("C C4C6n C4C6n n", $pkt);
		
		$self->{type} = $type;
		
		$self->{dest_network} = _addr_to_string(@dst_network);
		$self->{dest_node}    = _addr_to_string(@dst_node);
		$self->{dest_socket}  = $dst_socket;
		
		$self->{src_network} = _addr_to_string(@src_network);
		$self->{src_node}    = _addr_to_string(@src_node);
		$self->{src_socket}  = $src_socket;
		
		$self->{data}   = substr($pkt, 27);
		
		return undef if($length != length($self->{data}));
	}
	
	return $self;
}

#
# Strip header from packet and return the data contained in it
#

sub strip {
	my ($pkt) = @_;
	return NetPacket::IPX->decode($pkt)->{data};
}   

#
# Encode a packet
#

sub encode
{
	my ($self) = @_;
	
	return pack("C", $self->{type})
		._addr_from_string($self->{dest_network})
		._addr_from_string($self->{dest_node})
		.pack("n", $self->{dest_socket})
		._addr_from_string($self->{src_network})
		._addr_from_string($self->{src_node})
		.pack("n", $self->{src_socket})
		.pack("n", length($self->{data}))
		.$self->{data};
}

sub _addr_to_string
{
	my (@bytes) = @_;
	return join(":", map { sprintf("%02X", $_) } @bytes);
}

sub _addr_from_string
{
	my ($string) = @_;
	return join("", map { pack("C", hex($_)) } split(m/:/, $string));
}

1;