File Coverage

blib/lib/Net/RTP/Packet.pm

Criterion	Covered	Total	%
statement	120	141	85.1
branch	27	38	71.0
condition			n/a
subroutine	19	22	86.3
pod	18	19	94.7
total	184	220	83.6

package Net::RTP::Packet;

################
#
# Net::RTP::Packet: Pure Perl RTP Packet object (RFC3550)
#
# Nicholas J Humfrey, [e-mail]
#

use strict;
use Carp;

use vars qw/$VERSION/;
$VERSION="0.05";


# Seed a random number for old versions of perl
if ($] < 5.004) {
	srand(time ^ ($$ + ($$ << 15)));
}


sub new {
    my $class = shift;
	my ($bindata) = @_;

	# Store parameters
    my $self = {
		version => 2,
		padding => 0,
		extension => 0,
		marker => 0,
		payload_type => 0,
		seq_num => 0,
		timestamp => 0,
		ssrc => 0,
		csrc => [],
		payload => '',
		size => undef,
		source_ip => undef,
		source_port => undef,
    };
    bless $self, $class;


	# Decode binary packet?
	if (defined $bindata) {
		$self->decode( $bindata );
	} else {
		# Randomise sequence, timestamp and SSRC
		$self->{'seq_num'} = int(rand(2**16));
		$self->{'timestamp'} = int(rand(2**32));
		$self->{'ssrc'} = int(rand(2**32));
	}

	return $self;
}


sub version {
	my $self = shift;
	my ($version) = @_;
	$self->{'version'} = $version if (defined $version);
	return $self->{'version'};
}

sub padding {
	my $self = shift;
	my ($padding) = @_;
	$self->{'padding'} = $padding if (defined $padding);
	return $self->{'padding'};
}

sub extension {
	my $self = shift;
	return $self->{'extension'};
}

sub marker {
	my $self = shift;
	my ($marker) = @_;
	$self->{'marker'} = $marker if (defined $marker);
	return $self->{'marker'};
}

sub payload_type {
	my $self = shift;
	my ($payload_type) = @_;
	$self->{'payload_type'} = $payload_type if (defined $payload_type);
	return $self->{'payload_type'};
}

sub seq_num {
	my $self = shift;
	my ($seq_num) = @_;
	$self->{'seq_num'} = $seq_num if (defined $seq_num);
	return $self->{'seq_num'};
}

sub seq_num_increment {
	my $self = shift;

	my ($value) = @_;
	$value = 1 unless (defined $value);
	$self->{'seq_num'} += $value;

	return $self->{'seq_num'};
}

sub timestamp {
	my $self = shift;
	my ($timestamp) = @_;
	$self->{'timestamp'} = $timestamp if (defined $timestamp);
	return $self->{'timestamp'};
}

sub timestamp_increment {
	my $self = shift;

	my ($value) = @_;
	$value = 1 unless (defined $value);
	$self->{'timestamp'} += $value;

	return $self->{'timestamp'};
}

sub ssrc {
	my $self = shift;
	my ($ssrc) = @_;
	$self->{'ssrc'} = $ssrc if (defined $ssrc);
	return $self->{'ssrc'};
}

sub csrc {
	my $self = shift;
	my ($csrc) = @_;
	if (defined $csrc) {
		if (ref($csrc) ne 'ARRAY') {
			carp "CSRC should be an ARRAYREF";
		} else {
			$self->{'csrc'} = $csrc ;
		}
	}
	return $self->{'csrc'};
}

sub payload {
	my $self = shift;
	my ($payload) = @_;
	$self->{'payload'} = $payload if (defined $payload);
	return $self->{'payload'};
}

sub payload_size {
	my $self = shift;
	return length($self->{'payload'});
}

sub source_ip {
	my $self = shift;
	return $self->{'source_ip'};
}

sub source_port {
	my $self = shift;
	return $self->{'source_port'};
}

sub size {
	my $self = shift;

	# Encode the packet if the size isn't known
	unless (defined $self->{'size'}) {
		# Not very efficient, but sure to work
		$self->encode();
	}

	return $self->{'size'};
}

sub decode {
	my $self = shift;
	my ($bindata) = @_;

	# Store the size of the packet we are decoding
	$self->{'size'} = length( $bindata );

	# Decode the binary header (network endian)
	my ($vpxcc, $mpt, $seq_num, $timestamp, $ssrc) = unpack( 'CCnNN', $bindata );
	$bindata = substr( $bindata, 12 );

	# We only know how to parse version 2 of RTP
	$self->{'version'} = ($vpxcc & 0xC0) >> 6;
	if ($self->{'version'} != 2) {
		carp "Warning: unsupported RTP packet version ($self->{'version'})";
		return 0;
	}

	# Extract from the bit fields
	$self->{'padding'} = ($vpxcc & 0x20) >> 5;
	$self->{'extension'} = ($vpxcc & 0x10) >> 4;
	my $csrc_count = ($vpxcc & 0x0F) >> 0;
	$self->{'marker'} = ($mpt & 0x80) >> 7;
	$self->{'payload_type'} = ($mpt & 0x7F) >> 0;
	$self->{'seq_num'} = $seq_num;
	$self->{'timestamp'} = $timestamp;
	$self->{'ssrc'} = $ssrc;


	# Process CSRC list
	for(my $c=0; $c<$csrc_count; $c++) {
		my $csrc = unpack('N', $bindata );
		$bindata = substr( $bindata, 4 );

		# Append it on to the list
		push( @{$self->{'csrc'}}, $csrc );
	}

	# Ignore any header extention
	if ($self->{'extension'}) {
		my ($foo, $len) = unpack('nn', $bindata );
		$bindata = substr( $bindata, ($len+1)*4 );
	}

	# Ignore padding on end of packet
	if ($self->{'padding'}) {
		$self->{'padding'} = unpack('C', substr( $bindata, -1, 1 ));
	}

	# Whats left is the payload
	my $len = length( $bindata ) - $self->{'padding'};
	$self->{'payload'} = substr($bindata,0,$len);

	# Undefine the source IP and port
	# (it is unknown and set elsewhere)
	$self->{'source_ip'} = undef;
	$self->{'source_port'} = undef;

	# Success
	return 1;
}


sub encode {
	my $self = shift;
	my $bindata = '';

	my $csrc_count = scalar(@{$self->{'csrc'}});
	my $pad = 0; $pad = 1 if ($self->{'padding'});

	my $vpxcc = 0;
	$vpxcc |= ($self->{'version'} << 6) & 0xC0;
	$vpxcc |= ($pad << 5) & 0x20;
	$vpxcc |= ($self->{'extension'} << 4) & 0x10;
	$vpxcc |= ($csrc_count & 0x0F);
	$bindata .= pack('C', $vpxcc);

	my $mpt = 0;
	$mpt |= ($self->{'marker'} << 7) & 0x80;
	$mpt |= ($self->{'payload_type'} & 0x7F);
	$bindata .= pack('C', $mpt);

	$bindata .= pack('n', $self->{'seq_num'});
	$bindata .= pack('N', $self->{'timestamp'});
	$bindata .= pack('N', $self->{'ssrc'});

	# Append list of CSRC
	foreach( @{$self->{'csrc'}} ) {
		$bindata .= pack('N', $_);
	}

	# Append the payload
	$bindata .= $self->{'payload'};

	# Append the padding
	if ($self->{'padding'}) {
		for(my $p=0; $p<($self->{'padding'}-1); $p++) {
			$bindata .= pack('C', 0);
		}
		$bindata .= pack('C', $self->{'padding'});
	}

	# Store the size of the encoded packet
	$self->{'size'} = length( $bindata );

	return $bindata;
}


1;

__END__