use strict;
use warnings;

############################################################################
#
#   wrap Net::SIP::NATHelper::Base
#   read commands from socket and propagete them to NATHelper, send
#   replies back
#
############################################################################

package Net::SIP::NATHelper::Server;
use fields qw( helper callbacks cfd commands );

use Net::SIP qw(invoke_callback :debug);
use Net::SIP::NATHelper::Base;
use Storable qw(thaw nfreeze);
use Data::Dumper;

my %default_commands = (
	allocate => sub { shift->allocate_sockets(@_) },
	activate => sub { shift->activate_session(@_) },
	close    => sub { shift->close_session(@_) },
);


############################################################################
# new NAThelper
# Args: ($class,?$helper,@socket)
#  $helper: Net::SIP::NATHelper::Base object, will be created if not given
#  @socket: SOCK_STREAM sockets for communication SIP proxies
# Returns: $self
############################################################################
sub new {
	my $class = shift;
	my $helper;
	if ( @_ && UNIVERSAL::isa( $_[0],'Net::SIP::NATHelper::Base' )) {
		$helper = shift;
	} else {
		$helper = Net::SIP::NATHelper::Base->new;
	}
	my $self = fields::new( $class );
	%$self = (
		helper => $helper,
		callbacks => [],
		cfd => \@_,
		commands => { %default_commands },
	);
	return $self,
}

############################################################################
# read + execute command
# command is transported as [ $cmd,@args ] using Storable::nfreeze
# and reply is transported back using nfreeze too
# Args: $self
# Returns: NONE
############################################################################
sub do_command {
	my Net::SIP::NATHelper::Server $self = shift;
	my $cfd = shift;

	my $sock = $cfd->accept || do {
		DEBUG( 50,"accept failed: $!" );
		return;
	};
	$sock->autoflush;

	read( $sock,my $buf, 4 ) || do {
		DEBUG( 50, "read of 4 bytes len failed: $!" );
		return;
	};
	my $len = unpack( "N",$buf );
	DEBUG( 50, "len=$len" );
	if ( $len > 32768 ) {
		warn( "tooo much data to read, unbelievable len=$len" );
		return;
	}
	read( $sock,$buf, $len ) || do {
		DEBUG( 50,"read of $len bytes failed: $!" );
		return;
	};

	my ($cmd,@args) = eval { @{ thaw( $buf ) } } or do {
		DEBUG( 50,"thaw failed: $@" );
		return;
	};

	DEBUG( 100, "request=".Dumper([$cmd,@args]));
	my $cb = $self->{commands}{$cmd} or do {
		DEBUG( 10,"unknown command: $cmd" );
		return;
	};
	my $reply = invoke_callback($cb,$self,@args);
	unless ( defined( $reply )) {
		DEBUG( 10, "no reply for $cmd" );
	}

	DEBUG( 100, "reply=".Dumper($reply));

	# nfreeze needs reference!
	print $sock pack( "N/a*",nfreeze(\$reply));
	close($sock);
}


############################################################################
# loop:
# * if received new command execute it
# * if receive data on RTP sockets forward them
# Args: $self
# Returns: NEVER
############################################################################
sub loop {
	my Net::SIP::NATHelper::Server $self = shift;

	my $rin; # select mask
	my $last_expire = 0;
	my $helper = $self->{helper};

	while (1) {

		# @$callbacks get set to empty in _update_callbacks which get
		# called if something on the sockets changed. In this case
		# recompute the callbacks. This is not the fastest method, but
		# easy to understand :)

		my $callbacks = $self->{callbacks};
		my $timeout = 1;
		if ( !@$callbacks ) {
			# recompute callbacks:
			# - add callbacks from NATHelper
			foreach ( $helper->callbacks ) {
				my ($fd,$cb) = @$_;
				$callbacks->[ fileno($fd) ] = $cb;
			}

			# if nothing to do on helper set timeout to infinite
			if ( !@$callbacks && ! $helper->number_of_calls ) {
				$timeout = undef;
				DEBUG( 50,"no RTP socks: set timeout to infinite" );
			}

			# - and for command sockets
			foreach my $cfd ( @{ $self->{cfd} } ) {
				$callbacks->[ fileno($cfd) ] = [ \&do_command, $self,$cfd ];
			}

			# recompute select mask
			$rin = '';
			for( my $i=0;$i<@$callbacks;$i++ ) {
				vec( $rin,$i,1 ) = 1 if $callbacks->[$i]
			}

		}

		# select which sockets got readable or timeout
		$rin || die;
		defined( select( my $rout = $rin,undef,undef,$timeout ) ) || die $!;
		my $now = time();

		# handle callbacks on sockets
		if ( $rout ) {
			for( my $i=0;$i<@$callbacks;$i++ ) {
				invoke_callback( $callbacks->[$i] ) if vec( $rout,$i,1 );
			}
		}

		# handle expires
		if ( $now - $last_expire >= 1 ) {
			$last_expire = $now;
			$self->expire;
			DEBUG( 100, $helper->dump );
		}
	}
}

############################################################################
# wrap methods in helper to call _update_callbacks when appropriate
############################################################################
sub expire {
	my Net::SIP::NATHelper::Server $self = shift;
	my @expired = $self->{helper}->expire(@_);
	@expired && $self->_update_callbacks;
	return int(@expired);
}

sub allocate_sockets {
	my Net::SIP::NATHelper::Server $self = shift;
	my $media = $self->{helper}->allocate_sockets(@_) || return;
	#$self->_update_callbacks;
	return $media;
}

sub activate_session {
	my Net::SIP::NATHelper::Server $self = shift;
	my ($info,$duplicate) = $self->{helper}->activate_session(@_)
		or return;
	$self->_update_callbacks;
	return $duplicate ? -1:1;
}

sub close_session {
	my Net::SIP::NATHelper::Server $self = shift;
	my @info = $self->{helper}->close_session(@_) or return;
	$self->_update_callbacks;
	return scalar(@info);
}


sub _update_callbacks {
	my Net::SIP::NATHelper::Server $self = shift;
	@{ $self->{callbacks} } = ();
}

1;