###########################################################################
# package Net::SIP::Dispatcher::Eventloop
# simple event loop for Net::SIP
###########################################################################

use strict;
use warnings;

package Net::SIP::Dispatcher::Eventloop;
use fields qw( fd timer now );
use Time::HiRes qw(gettimeofday);
use Socket;
use List::Util qw(first);
use Net::SIP::Util 'invoke_callback';
use Net::SIP::Debug;
use Errno 'EINTR';

###########################################################################
# creates new event loop
# Args: $class
# Returns: $self
###########################################################################
sub new {
	my $class = shift;
	my $self = fields::new($class);
	%$self = (
		fd => [],
		timer => [],
		now => scalar(gettimeofday()),
	);
	return $self;
}

###########################################################################
# adds callback for the event, that FD is readable
# Args: ($self,$fd,$callback,?$name)
#  $fd: file descriptor
#  $callback: callback to be called, when fd is readable, will be called
#    with fd as argument
#  $name: optional name for callback, used for debugging
# Returns: NONE
###########################################################################
sub addFD {
	my Net::SIP::Dispatcher::Eventloop $self = shift;
	my ($fd,$callback,$name) = @_;
	defined( my $fn = fileno($fd)) || return;
	#DEBUG( 100, "$self added fn=$fn sock=".eval { my ($port,$addr) = unpack_sockaddr_in( getsockname($fd)); inet_ntoa($addr).':'.$port } );
	$self->{fd}[$fn] = [ $fd,$callback,$name ];
}

###########################################################################
# removes callback for readable for FD
# Args: ($self,$fd)
#  $fd: file descriptor
# Returns: NONE
###########################################################################
sub delFD {
	my Net::SIP::Dispatcher::Eventloop $self = shift;
	my ($fd) = @_;
	defined( my $fn = fileno($fd)) || return;
	#DEBUG( 100, "$self delete fn=$fn sock=".eval { my ($port,$addr) = unpack_sockaddr_in( getsockname($fd)); inet_ntoa($addr).':'.$port } );
	delete $self->{fd}[$fn];
}

###########################################################################
# add timer
# Args: ($self,$when,$callback;$repeat,$name)
#  $when: absolute time_t or relative (smaller than a year), can be
#    subsecond resolution
#  $callback: callback to be called, gets timer object as argument
#  $repeat: interval for repeated callbacks, optional
#  $name: optional name for debugging
# Returns: $timer object
###########################################################################
sub add_timer {
	my Net::SIP::Dispatcher::Eventloop $self = shift;
	my ($when,$callback,$repeat,$name ) = @_;
	$when += $self->{now} if $when < 3600*24*365;

	my $timer = Net::SIP::Dispatcher::Eventloop::TimerEvent->new(
		$when, $repeat, $callback,$name );
	push @{ $self->{timer}}, $timer;
	return $timer;
}

###########################################################################
# return time of currentloop, e.g. when select(2) returned
# Args: ()
# Returns: time
###########################################################################
sub looptime {
	my Net::SIP::Dispatcher::Eventloop $self = shift;
	return $self->{now}
}


###########################################################################
# simple mainloop
# Args: ($self;$timeout,@stop)
#  $timeout: if 0 just poll once, if undef never return, otherwise return
#    after $timeout seconds
#  @stop: \@array of Scalar-REF, if one gets true the eventloop will be stopped
# Returns: NONE
###########################################################################
sub loop {
	my Net::SIP::Dispatcher::Eventloop $self = shift;
	my ($timeout,@stop) = @_;

	# looptime for this run
	my $looptime = $self->{now} = gettimeofday();

	# if timeout defined and != 0 set $end to now+timeout
	# otherwise set end to undef|0 depending on timeout
	my $end = $timeout ? $looptime + $timeout : $timeout;
	my $to = $timeout;

	while ( !$to || $to>0 ) {

		DEBUG( 100, "timeout = ".( defined($to) ? $to: '<undef>' ));
		# handle timers
		my $timer = $self->{timer};

		my $do_timer = 1;
		while ( @$timer && $do_timer ) {
			$do_timer = 0;
			@$timer = sort { $a->{expire} <=> $b->{expire} } @$timer;

			# delete canceled timers
			shift(@$timer) while ( @$timer && !$timer->[0]{expire} );

			# run expired timers
			while ( @$timer && $timer->[0]{expire} <= $looptime ) {
				my $t = shift(@$timer);
				DEBUG( 50, "trigger timer(%s) %s repeat=%s",
					$t->name,$t->{expire} || '<undef>', $t->{repeat} || '<undef>' );
				invoke_callback( $t->{callback},$t );
				if ( $t->{expire} && $t->{repeat} ) {
					$t->{expire} += $t->{repeat};
					DEBUG( 100, "timer(%s) gets repeated at %d",$t->name,$t->{expire} );
					push @$timer,$t;
					$do_timer = 1; # rerun loop
				}
			}
		}

		# adjust timeout for select based on when next timer expires
		if ( @$timer ) {
			my $next_timer = $timer->[0]{expire} - $looptime;
			$to = $next_timer if !defined($to) || $to>$next_timer;
		}
		DEBUG( 100, "timeout = ".( defined($to) ? $to: '<undef>' ));

		if ( grep { ${$_} } @stop ) {
			DEBUG( 50, "stopvar triggered" );
			return;
		}

		# wait for selected fds
		my $fds = $self->{fd};
		my $rin;
		if ( my @to_read = grep { $_ } @$fds ) {

			# Select which fds are readable or timeout
			my $rin = '';
			map { vec( $rin,fileno($_->[0]),1 ) = 1 } @to_read;
			DEBUG( 100, "handles=".join( " ",map { fileno($_->[0]) } @to_read ));
			select( my $rout = $rin,undef,undef,$to ) < 0 and do {
				next if $! == EINTR;
				die $!
			};
			# returned from select
			$looptime = $self->{now} = gettimeofday();
			DEBUG( 100, "can_read=".join( " ",map { $_ } grep { $fds->[$_] && vec($rout,$_,1) } (0..$#$fds)));
			for( my $fn=0;$fn<@$fds;$fn++ ) {
				vec($rout,$fn,1) or next;
				my $fd_data = $fds->[$fn] or next;
				DEBUG( 50,"call cb on fn=$fn ".( $fd_data->[2] || '') );
				invoke_callback( $fd_data->[1],$fd_data->[0] );
			}
		} else {
			DEBUG( 50, "no handles, sleeping for %s", defined($to) ? $to : '<endless>' );
			select(undef,undef,undef,$to )
		}

		if ( defined($timeout)) {
			last if !$timeout;
			$to = $end - $looptime;
		} else {
			$to = undef
		}
	}
}


##########################################################################
# Timer object which gets returned from add_timer and has method for
# canceling the timer (by setting expire to 0)
##########################################################################
package Net::SIP::Dispatcher::Eventloop::TimerEvent;
use fields qw( expire repeat callback name );

##########################################################################
# create new timer object, see add_timer for description of Args
# Args: ($class,$expire,$repeat,$callback)
# Returns: $self
##########################################################################
sub new {
	my ($class,$expire,$repeat,$callback,$name) = @_;
	my $self = fields::new( $class );
	unless ( $name ) {
		# check with caller until I find a function which is not
		# named 'add_timer'
		for( my $i=1;1;$i++ ) {
			my (undef,undef,undef,$sub) = caller($i) or last;
			next if $sub =~m{::add_timer$};
			my $line = (caller($i-1))[2];
			$name = "${sub}[$line]";
			last;
		}
	}
	%$self = (
		expire => $expire,
		repeat => $repeat,
		callback => $callback,
		name => $name
	);
	return $self;
}

##########################################################################
# cancel timer by setting expire to 0, it will be deleted next time
# the timer queue is scanned in loop
# Args: $self
# Returns: NONE
##########################################################################
sub cancel {
	my Net::SIP::Dispatcher::Eventloop::TimerEvent $self = shift;
	$self->{expire} = 0;
	$self->{callback} = undef;
}

##########################################################################
# returns name for debugging
# Args: $self
# Returns: $name
##########################################################################
sub name {
	my Net::SIP::Dispatcher::Eventloop::TimerEvent $self = shift;
	return $self->{name} || 'NONAME'
}

1;