File Coverage

blib/lib/Net/RTP.pm

Criterion	Covered	Total	%
statement	56	86	65.1
branch	12	40	30.0
condition	5	16	31.2
subroutine	14	16	87.5
pod	4	5	80.0
total	91	163	55.8

package Net::RTP;

################
#
# Net::RTP: Pure Perl Real-time Transport Protocol (RFC3550)
#
# Nicholas J Humfrey
# [e-mail]
#

use Net::RTP::Packet;
use Socket;
use strict;
use Carp;



# Use whatever Superclass we can find first
# we would prefer to have a multicast socket...
BEGIN {
	my @superclasses = (
		'IO::Socket::Multicast6 0.02',
		'IO::Socket::Multicast 1.00',
		'IO::Socket::INET6 2.51',
		'IO::Socket::INET 1.20',
	);

	our $SUPER_CLASS = undef;
	foreach my $super (@superclasses) {
		eval "use $super";
		unless ($@) {
			($SUPER_CLASS) = ($super =~ /^([\w:]+)/);
			last;
		}
	}

	unless (defined $SUPER_CLASS) {
		die "Failed to load any of super classes.";
	}


	# Check to see if Socket6 is available
	our $HAVE_SOCKET6 = 0;
	eval "use Socket6 qw/ AF_INET6 unpack_sockaddr_in6 inet_ntop /;";
	$HAVE_SOCKET6=1 unless ($@);
}



use vars qw/$VERSION @ISA $SUPER_CLASS $HAVE_SOCKET6/;
@ISA = ($SUPER_CLASS);
$VERSION="0.09";




sub new {
    my $class = shift;
	unshift @_,(Proto => 'udp') unless @_;
	return $class->SUPER::new(@_);
}


sub configure {
	my($self,$arg) = @_;

	# Default to UDP instead of TCP
	$arg->{Proto} ||= 'udp';
	$arg->{ReuseAddr} ||= 1;
	my $result = $self->SUPER::configure($arg);


	if (defined $result) {
		# Join group if it a multicast IP address
		my $group = $self->sockhost();
		if (_is_multicast_ip($group)) {
			if ($self->superclass() =~ /Multicast/) {
				#print "Joining group: $group\n";
				$self->mcast_add( $group ) || croak "Failed to join multicast group";
			} else {
				croak "Error: can't receive multicast without either ".
					  "IO::Socket::Multicast or IO::Socket::Multicast6 installed.";
			}
		}
	}

	return $result;
}


sub _is_multicast_ip {
	my ($group) = @_;

	return 0 unless (defined $group);

	# IPv4 multicast address ?
	if ($group =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
		return 1 if ($1 >= 224 and $1 <= 239);

	# IPv6 multicast address ?
	} elsif ($group =~ /^ff[0-9a-f]{2}\:/i) {
		return 1;
	}

	# Not an multicast IP
	return 0;
}


sub superclass {
	return $SUPER_CLASS;
}


sub recv {
	my $self=shift;
	my ($size) = @_;

	# Default read size
	$size = 2048 unless (defined $size);

	# Receive a binary packet
	my $data = undef;
	my $sockaddr_in = $self->SUPER::recv($data, $size);
	if (defined $data and $data ne '') {

		# Parse the packet
		my $packet = new Net::RTP::Packet( $data );

		# Store the source address
		if ($sockaddr_in ne '' and defined $packet)
		{
			if ($self->sockdomain() == &AF_INET) {
				my ($port,$addr) = unpack_sockaddr_in($sockaddr_in);
				$packet->{'source_ip'} = inet_ntoa($addr);
				$packet->{'source_port'} = $port;

			} elsif ($HAVE_SOCKET6) {
				eval {
					if ($self->sockdomain() == &AF_INET6) {
						my ($port,$addr) = unpack_sockaddr_in6($sockaddr_in);
						$packet->{'source_ip'} = inet_ntop(&AF_INET6, $addr);
						$packet->{'source_port'} = $port;
					}
				};
			}

			# Failed to decode socket address ?
			unless (defined $packet->{'source_ip'}) {
				warn "Failed to get socket address for family: ".$self->sockdomain();
			}
		}

		return $packet;
	}

	return undef;
}


sub send {
	my $self=shift;
	my ($packet) = @_;

	if (!defined $packet or ref($packet) ne 'Net::RTP::Packet') {
		croak "Net::RTP->send() takes a Net::RTP::Packet as its only argument";
	}

	# Build packet and send it
	my $data = $packet->encode();
	return $self->SUPER::send($data);
}


sub DESTROY {
    my $self=shift;
	return $self->SUPER::DESTROY(@_);
}



1;

__END__