use strict;
use Net::SIP qw(:all);
use Getopt::Long qw(:config posix_default bundling);

my $debug;
my $from = 'sip:me@one.example.com';
my $outgoing_proxy = '127.0.0.1:5070';
my $stat_timer = 2;
my $ncalls = 10;
my $to = 'sip:me@two.example.com';

GetOptions(
    'd|debug:i' => \$debug,
    'h|help' => sub { usage() },
    'F|from=s' => \$from,
    'T|to=s' => \$to,
    'P|proxy=s' => \$outgoing_proxy,
    'S|stat-timer=i' => \$stat_timer,
    'N|parallel=i' => \$ncalls,
) || usage( 'bad options' );
Debug->level( $debug || 1 ) if defined $debug;

my $loop = Net::SIP::Dispatcher::Eventloop->new;
my $ua = Simple->new(
    from => $from,
    outgoing_proxy => $outgoing_proxy,
    loop => $loop,
);

my (@connected,$start_bench,$min_delay,$max_delay);
my $ignored = my $ok = my $lost = my $sum_delay = 0;
for my $call (1..$ncalls) {
    my $connected;
    my $send_seq = 1;
    my $recv_seq = 0;
    $ua->invite( $to,
	cb_final => \$connected,
	init_media => $ua->rtp( 'send_recv',
	    [ \&send_rtp, \$send_seq ],
	    0,
	    [ \&recv_rtp, \$recv_seq ]
	),
    );
    push @connected,\$connected
}

$ua->loop( @connected );
print STDERR "All $ncalls calls connected....\n";

$start_bench = 1;
my $start = time();
$ua->add_timer( $stat_timer, \&stat_timer, 2 );
$ua->loop;

sub stat_timer {
    if ( $ok ) {
	printf "%5d pkt=%d/%d/%d delay(ms)=%.2f/%.2f/%.2f\n",
	    time() - $start,
	    $ok,$lost,$ignored,
	    $sum_delay/$ok*1000, $min_delay*1000,$max_delay*1000;
    } else {
	printf "%5d pkt=%d/%d/%d\n",
	    time() - $start,
	    $ok,$lost,$ignored;
    }
    $sum_delay = $ok = $lost = $ignored = 0;
    $min_delay = $max_delay = undef;
}

sub send_rtp {
    my $rseq = shift;
    my $now = $loop->looptime;
    my $sec = int($now);
    my $msec = ( $now - $sec ) * 1_000_000;
    my $seq = $start_bench ? $$rseq++ : 0;
    return pack( "NNN",$seq,$sec,$msec ) . ( ' ' x 148 );
}

sub recv_rtp {
    my ($rseq,$payload) = @_;
    my ($seq,$sec,$msec) = unpack( "NNN",$payload );
    #print STDERR "seq=$seq\n";
    return if ! $seq; # initial data

    my $diff = $seq - $$rseq;
    if ( $diff <= 0 || $diff > 10000 ) {
	# bogus, retransmits?
	$ignored++;
	return;
    }

    $lost += $diff-1;
    $$rseq = $seq;
    $ok++;
    my $now = $loop->looptime;
    my $then = $sec + $msec/10**6;
    my $delay = $now - $then;
    die "now=".localtime($now)." then=".localtime($then) if $delay<0;
    $sum_delay += $delay;
    $min_delay = $delay if ! defined $min_delay || $min_delay > $delay;
    $max_delay = $delay if ! defined $max_delay || $max_delay < $delay;
}

sub usage {
    print STDERR "ERROR: @_\n" if @_;
    print STDERR <<USAGE;


Makes N parallel calls from FROM to TO and writes statistics about received, lost
packets and delays. Does not send real RTP, but hides non-RTP data within RTP frames
to compute statistics.
Usage: $0 options
Options:
 -h|--help      This usage
 -d|--debug     Switch on debugging with optional level
 -F|--from      local address, default $from
 -T|--to        peer address, default $to
 -P|--proxy     Adress of target or proxy on path to target, default $outgoing_proxy
 -N|--parallel  Number of parallel calls, default $ncalls
 -S|--stat-timer  How often to print statistics, default every $stat_timer seconds

The statistics look like this:

 28 pkt=1005/0/0 delay(ms)=5.68/1.08/41.79
 |       |   | |            |    |    |
 |       |   | |            ---------------- avg/min/max delay in ms
 |       |   | |---------------------------- ignored packets (retransmits..)
 |       |   |------------------------------ lost packets (or received out of order)
 |       |---------------------------------- good packets received
 |------------------------------------------ seconds since start

USAGE
    exit(2);
}