#!/usr/bin/perl

# compute packet stream quality statistics for UDP/RTP from network or captured files(pcap)
# Base Olav Kvittem
# Mpeg support Odd Rune Mykkeltveit Lykkbo,  2009-2010
# Mos values computation Gurvinder Singh, 2010-05-07
# XML, RTMP, TCP support, Pål Moen Møst, 2011

# use Socket;
use IO::Socket qw(:DEFAULT :crlf);
use IO::Socket::INET;
use IO::Socket::Multicast;
use IO::Select;
use Net::Pcap;
use NetPacket::Ethernet qw(:strip);
use NetPacket::IP;
use NetPacket::IP qw(:strip  :protos);;
use NetPacket::UDP;
use NetPacket::TCP;
use Net::IPv6Addr;
#use NetPacket::IPv6 qw(ipv6_strip);
#use Net::RTP;
use Net::RTP::Packet;
use Time::HiRes qw/ sleep time tv_interval gettimeofday/;
use Data::Dumper;
use threads;
use threads::shared;
use Pod::Usage;
#use bigint qw/ hex oct/;
use Math::BigInt;
use Math::BigFloat;
use Carp;
#RTMP implementation *experimental*
use rtmp::client qw(rtmp_connect rtmp_play rtmp_call get_chunk_ids);
use constant MTU => 1580;
#XML
use XML::DOM;
use XML::Twig;
#use mpegpackets;
$DEFAULT_PORT = 1955;

#my oh my,more globals
my ($rtmp,$period,$last,$debug,$swfurl,$pageurl,$flash_version,$reconnect);

require "newgetopt.pl";

@opts=('list', 'man','fullformat', 'net', 'rtp', 'mpeg', 'pcap', 'crude', 'bins=s', 'log', 'nperiod=s', 'period=s', 'last=s', 'packets=s', 'src=s', 'flow_key=s', 'flow_no=s', 'flow_min=s', 'nohead', 'dump=s', 'format=s', 'id=s', 'sum=s', 'ttl', 'rtt=s', 'codec=s', 'log', 'verbose', 'v', 'h', 'debug', 'av','xml=s', 'rtmp','tcp', 'port=s','swfurl=s','pageurl=s','flashversion=s','new','q','exclude=s','report=s', 'filename','test','ipv6','p=s','name=s','tcp_t','wait=s');


&NGetOpt(@opts) || die pod2usage(1);
die pod2usage(1)  if $opt_h;
$continous= ! $opt_packets;
$opt_v=$opt_v or $opt_verbose;
my $codec = $opt_codec || 'G.711';
my $rtt = $opt_rtt || 10;		# ms round trip time of the connection
pod2usage(-verbose => 2 ) if $opt_man;

my $initial_wait= $opt_wait || 3 ; # frac seconds to wait initially
my $timeout = $initial_wait;
my $next_wait=0.1 ; # frac seconds to wait for receiving between packets

my @streams=@ARGV;

if ($opt_bins){
    @bins=split(/,/, $opt_bins);
}
if ($opt_report){
    @filter=split(/,/, $opt_report);
}
my $format = $opt_format || "pretty";

my %hdr=();
my $err="";
my $us=0; # current packet time in us
my $nkill=0;
my $nint=0;
my $n_packets=0;
my $endstream=0;
my $period_num = 0;
my $pcr_count = 0;
my $pts_count =  0;
my $doc;
my $xml;
my $xml_printed= 0;
my $last_stream;
my $file_flag;
my $offline;
my $lost_counter  = 0;

#TCP STUFF
my $thr;
my $rtmp_port:shared = 1935; 
my $rtmp_addr:shared;
my %tcp_packet_stats:shared = ();
my %bw_stats:shared = ();
my %seq_stats:shared = ();
my %seq_stats_n =();
my $n_seq_num:shared=0;
my $rtmp_stream_start:shared;
my $tcp_stop:shared;
my %hash : shared;

my $packet_re_num:shared=0;
$seq_stats{'p_seq_num'} = 0;
$seq_stats{'p_tcp_time_stamp'} = 0;
$seq_stats{'p_tcp_time_stamp_echo'} = 0;
$seq_stats{'real_last_time'} = 0;
#init packetstats
$tcp_packet_stats{'pkt_lost'} = 0;
$tcp_packet_stats{'pkt_late'} = 0;
$tcp_packet_stats{'pkt_dup'} = 0 ;
$tcp_packet_stats{'pkt_retrans'} = 0;

my %offset_bytes =();
my %network_info =();

my $start_time = time();
#MPEG-TS measurement globals (most are reset in init)
my $CHECK_NUM_TSP = 2;
#globals for mpeg ts 
#a tabel for transport streams pids. aleternativ to PAT impl.
my %pcr_pid = ();
my $TS;
my @cc = ();
my $discontinuities = 0;
my %last_ccs = ();
my $packets_between_pcr = 0;
#my $PTS_MAX = 95443.7176888888888888
my $PTS_MAX = 95443;
my $PCR_MAX = 95443;
# pcr_stats {filename/handle}
my %pcr_stats = ();
#PTS-stats {filename/handle}
my %pts_stats = ();
my %mpeg_stats = ();
my %jitter_stats = ();

#PTS stuff
#my $real_time = time();
my $late_video_packets = 0;

#CC distribution
my $num_cc = 0;
my %cc_dist = ();
my %pid_next_cc = ();

my %dist1 = ();
my %dist2 = ();

$opt_period = $opt_last if not $opt_period;

$file_flag = 1 if $opt_filename;

#MPEG-TS END


$SIG{USR2} = sub {confess "Caught by SIGUSR2"; };

$SIG{INT} = sub { $uninterrupted=0; # return if $nint++  < 1;
		  &display_stats() if  !$endstream;
		  &end_xml() if $opt_xml;
		  &handle_threads()  if ($opt_tcp and $opt_rtmp);
		  
		  die "End after interrupt.\n";exit(0) };

$SIG{TERM} = sub { $uninterrupted=0; # return if $nkill++ < 1;
		   &display_stats() if  !$endstream;  
		   &end_xml() if $opt_xml;
		   &handle_threads()  if ($opt_tcp and $opt_rtmp);

		  die "End after sigterm.\n";exit(0) };

$SIG{ALRM} = sub { 
#   Writes stats to file if option XML is given. -PMM
#    die "No packets received" if $n_packets < 1;
    $uninterrupted=0;
    if  (! $endstream) {  # Changed logic 20120706:1007 CDT
		$endstream=1;
#ok	&display_stats;
    }
#	die "End after alarm\n"; 
#	return(0);
    print "endstream=1" if $opt_debug;
};

if ($opt_dump){
    open DUMP, ">$opt_dump";
}

if ($opt_test){
    if($opt_mpeg || $opt_rtp || $opt_tcp_t){
	&unit_test;
    }
    else {
	print "You need to choose a test. (mpeg, tcp or rtp) \n";
    }
}

if ($opt_pcap || ($opt_tcp && !$opt_rtmp)){ # listen in parallell
    alarm($opt_last) if $opt_last; 
    $uninterrupted=1;
    $endstream=0;
    eat_pcap_streams(@streams);
    &display_stats() if !$opt_xml and !$endstream;
} else { # listen serially
    my $stream_count;
    #my $ln = @streams;
    foreach $id (@streams) {
	alarm($opt_last) if $opt_last;
	++$stream_count;
	#$last_stream = 1 if $stream_count == ($ln);
	#print "count $stream_count  lengde  $ln \n";
	$uninterrupted=1;
	$endstream=0;
	init_file($id);
	eat_stream($id) if (!($opt_tcp || $opt_rtmp));
	&rtmp_eat_stream($id,$opt_period, $opt_last,0,$opt_debug,$opt_swfurl,$opt_pageurl,$opt_flashversion) if $opt_rtmp;
	#&eat_tcp($id,$opt_port) if $opt_tcp && !$opt_rtmp;
	if (! ( $opt_list || $opt_sum || $opt_period)){
	    &display_stats();
	}
	last if ! $uninterrupted;
    }
    
}
&list_flows if $opt_list;
&display_stats() if $opt_sum and !$endstream;
&display_bins if $opt_bins;
&end_xml() if $opt_xml;

exit(0);
#
sub unit_test {
    my $test_data = shift;
    #streams =  "rtp_158.38.130.110_6711_1.pcap";
    if ($opt_mpeg){
	@streams = "testing/pcap/testdata_mpeg.pcap";
	@filter = qw "video audio";
    }
    @streams = "testing/pcap/testdata_rtp.pcap" if $opt_rtp;
    @streams = "testing/pcap/testdata_tcp.pcap" if $opt_tcp_t;
    $opt_xml = "tmp_testdata.xml";
    $opt_q =  1;
    $opt_v = 1;
}
sub unit_test_2{
    #my ($orgnial_test) = &feed_data("file",rtp_file.xml);
    my $test_data;
    $test_data = "testing/xml/testdata_mpeg.xml" if $opt_mpeg;
    $test_data = "testing/xml/testdata_rtp.xml" if $opt_rtp;
    #$test_data = "udp_testdata" if $opt_net;
    $test_data = "testing/xml/testdata_tcp.xml" if $opt_tcp;
    my ($orginal_test) = &xml_parser($test_data);
    my ($new_test) = &xml_parser("tmp_testdata.xml");
    print Dumper($orginal_test), "\n", Dumper($new_test)if $opt_debug;
    my $ignore_pattern = "jitter";  #PCR jitter is based on delta local time. 
    my $ignore_pattern2  = "dwell";
    my $ignore_pattern3 ="delay_factor";
    my $ignore_pattern4 ="gap";
    print "Checking values ....\n";
    for my $k1(keys %$orginal_test){
	if ($orginal_test->{ $k1} != $new_test->{ $k1} and $orginal_test->{ $k1} !~ m/HASH/) {
	    print "different value @ $k1, value: $orginal_test->{$k1}, differs from value: $new_test->{$k1}\n";
	}
	else {
	    printf "%2s %2s\n", "OK  @ ", "$k1 ";
	}
	for my $k2 ( keys %{$orginal_test->{ $k1}} ) {
	    if ( ($orginal_test->{ $k1}{$k2} != $new_test->{ $k1}{$k2}) and ($k2 !~ m/$ignore_pattern/) and ($k2 !~ m/$ignore_pattern2/) and ($k2 !~ m/$ignore_pattern3/) and ($k2 !~ m/$ignore_pattern4/)){
		print "different value @ $k1-> $k2, value: $orginal_test->{$k1}{$k2} differs from, value: $new_test->{$k1}{$k2}\n";
	    }
	    
	}
    }
    print "Test complete \n";
}

sub xml_parser {
    my $file = shift;
    my $parser = new XML::DOM::Parser;
    my $doc = $parser->parsefile ($file);
    my $root = $doc->getFirstChild();
    my $nodelist = $root->getChildNodes();
    my $node = $nodelist->item(1);
    my $dup;
    my $flow_childs = $node->getChildNodes();
    my @test_array = ();
    my %test_hash = ();
    foreach my $child ($node->getChildNodes()) {
	if ($child->getNodeType == ELEMENT_NODE) {
	    if ($child->getChildNodes()){
		my @children = $child->getChildNodes();
		my $l = @children;
		if ($l > 1){
		    #print "=== " ,$child->getNodeName(), " === \n";
		    if (exists $test_hash{$child->getNodeName()}){
			$dup +=1;
		    }
		    foreach my $grandchild ($child->getChildNodes()){
			if ($grandchild->getNodeType == ELEMENT_NODE){
			    #print $grandchild->getNodeName(), "\n";
			    eval {
				$test_hash{$child->getNodeName().$dup}{$grandchild->getNodeName()}=  $grandchild->getFirstChild()->getData();
			    };
			    if ($@){
			    };
			}
		    }
		}
		else {
		    $test_hash{'flow'}{$child->getNodeName()} =  $child->getFirstChild()->getData();
     		}	
	    }
	} 
    }
    return (\%test_hash)
}

sub http_stream_client {
    my $f = shift;
    my $playlist = get("$f");
    my @list_items  = split(/\n/,$playlist);
    my @streams;
    my $duration;
    my $regex = "http://";
    my $p_chunk;
    while(1){
	foreach my $item (@list_items){
	    my @tmp_streams= get("$item");
	    if ($item=~ /$regex/g){
		foreach my $stream (@tmp_streams){
		    if ($stream =~ /EXT-X-TARGETDURATION/){
			my @temp =  split(/:/,$stream);
			$duration = $temp[1];
		    }
		    if($stream !~ /#/g){
			push(@streams,$stream);
			my $l = @streams;
			my $current_chunk = $streams[$l-1];
			if ($current_chunk ne $p_chunk){
			    my $data  = get("$current_chunk");
			    $p_chunk = $current_chunk;
			    sleep(9);
			}
		    }
		}
	    }
	}
    }
}
sub get_stream {
    my $uri = shift;
    my $data = get("$uri");
}

##TCP impl. -PMM
sub handle_threads {
    $tcp_stop = 1;
    $thr->join();
}
sub end_xml{
    my $filename;
    my $twig = XML::Twig->new(pretty_print => 'indented');
    my ($date,$time)  = &get_date_time();
    $filename = $opt_xml;
    $filename = $date."_".$time.".xml" if $opt_xml eq "date_time";
    open (MYFILE, '>'.$filename) || die "Could not open $filename : $!";
    my $final_xml = $doc->toString();
    $twig->parse($final_xml);
    $twig->flush(\*MYFILE);
    #print "</qstream> \n"  if $opt_xml eq "-";
    $doc->dispose;
    close (MYFILE);
    $xml_printed = 1;
    &unit_test_2($filename) if $opt_test;
}

sub tcp_packet_stats {
    my $f = shift;
    my $ip = shift;
    my ($tcp_obj) = shift;
    my $len,$ip_hlen = 0;
    #ipv6.pm uses different variables. 
    if($opt_ipv6){
	$len = plen;
    }
    else {
	$len = len;
	$ip_hlen = 20; 
    }
    #my $ip = NetPacket::IP->decode(eth_strip($pkt));
    #my $tcp_obj = NetPacket::TCP->decode(ip_strip(eth_strip($pkt)));
    #my $f = $ip->{src_ip}.":".$tcp_obj->{src_port} if !$offline;
    my $seq_num = $tcp_obj->{seqnum};
    my $options = $tcp_obj->{options}; #12 bytes
    #print "$tcp_obj->{src_port} \n";
    if (!exists $tcp_packet_stats{$f}){
	&init_stats($f);
	$tcp_packet_stats{$f} = &share( {} );
	$seq_stats{$f} = &share( {} );
	$seq_stats_n{$f} = &share( {} );
	$tcp_packet_stats{$f}{'pkt_late'} = 0;
	$tcp_packet_stats{$f}{'pkt_retrans'} =0;
	$tcp_packet_stats{$f}{'pkt_dup'} = 0;
	
    }
    ++$tcp_packet_stats{$f}{'num_packets'};
    &tcp_jitter_stats($f,$options);
    #Bandwidth messurements
    $tcp_packet_stats{$f}{'num_bytes'} += $ip->{$len}; #counts the bytes
    #Check for duplicated,out-of-order, late and lost packets.
    $seq_stats{$f}{'seq_diff'} = $seq_num - $seq_stats{$f}{'p_seq_num'} - $seq_stats{$f}{'p_packet_len'};
    if ($seq_stats_n{$f}{'seq_num_p'} == $seq_num && $seq_stats{$f}{'p_seq_num'} != 0) {
	++$tcp_packet_stats{$f}{'pkt_dup'};
    }
    if ($seq_stats{$f}{'seq_diff'} != 0 && $seq_stats{$f}{'p_seq_num'} != 0){
	if ($seq_stats{$f}{'seq_diff'} < 0){
	    ++$tcp_packet_stats{$f}{'pkt_late'};
	    if ($seq_stats_n{$f}{'seq_num_n'} == $seq_num){
		++$tcp_packet_stats{$f}{'pkt_retrans'};
	    }
	}
	else {
	    ++$tcp_packet_stats{$f}{'pkt_lost'};
	}
    }
    if($seq_stats{$f}{'p_seq_num'} < $seq_num){
	$seq_stats{$f}{'n_seq_num'} = ($seq_num+$ip->{$len} -($ip_hlen)-($tcp_obj->{hlen}*4))
    } 
    $seq_stats{$f}{'p_seq_num'} = $seq_num;
    $seq_stats{$f}{'p_packet_len'} = $ip->{$len}-($ip_hlen)-($tcp_obj->{hlen}*4);
    $seq_stats_n{$f}{'seq_num_p'} = $seq_num;
    $seq_stats_n{$f}{'seq_num_n'} = $seq_stats{$f}{'n_seq_num'};
}
sub tcp_jitter_stats {
    my $f = shift;
    my $options = shift;
    my $tcp_time_stamp_echo = unpack("N",substr($options,8,4));#from our client
    my $tcp_time_stamp_delta = $tcp_time_stamp - $seq_stats{$f}{'p_tcp_time_stamp'};
    my $tcp_time_stamp_echo_delta = $tcp_time_stamp_echo - $seq_stats{$f}{'p_tcp_time_stamp_echo'}; 
    $seq_stats{$f}{'p_tcp_time_stamp'} = $tcp_time_stamp;
    $seq_stats{$f}{'p_tcp_time_stamp_echo'} = $tcp_time_stamp_echo;
    my $real_time_delta = time() - $seq_stats{$f}{'real_last_time'};
    $seq_stats{$f}{'real_last_time'} = time();
    
    #After AV streams starts
    #$first_av_packet = &get_stream_start() if $opt_rtmp;
    #$first_av_packet = $tcp_packet_stats{'num_packets'} if !$opt_rtmp and $opt_tcp;
    
    if ($tcp_packet_stats{$f}{'num_packets'} > 1){
	#gaps
	$tcp_packet_stats{$f}{'gap_sum'} += $real_time_delta;
	$tcp_packet_stats{$f}{'gap_square'} +=$real_time_delta**2;
	if ($tcp_packet_stats{$f}{'gap_max'} < $real_time_delta){
	    $tcp_packet_stats{$f}{'gap_max'} = (10**3)*$real_time_delta;
	}
	if ($tcp_packet_stats{$f}{'gap_min'} > $real_time_delta){
	    $tcp_packet_stats{$f}{'gap_min'} = (10**3)*$real_time_delta;
	}
	my $jitter  = abs($tcp_time_stamp_delta - $real_time_delta*10**3);
	if($jitter  > $tcp_packet_stats{$f}{'jitter_max'} ){
	    $tcp_packet_stats{$f}{'jitter_max'}  = $jitter; 
	}
	if($jitter  < $tcp_packet_stats{$f}{'jitter_min'} ){
	    $tcp_packet_stats{$f}{'jitter_min'}  = $jitter;
	}
	$tcp_packet_stats{$f}{'jitter_sum'} += $jitter;
	$tcp_packet_stats{$f}{'jitter_square'} += $jitter**2;
    }
    else {
	$tcp_packet_stats{$f}{'jitter_min'} = 2**31;
	$tcp_packet_stats{$f}{'jitter_max'} =  0;
	$tcp_packet_stats{$f}{'gap_max'} =  0;
	$tcp_packet_stats{$f}{'gap_min'} = 2*31;
    }
}
sub check_period {
    my $f =  shift;
    if((($opt_last)+$start_time) < time() || (($opt_period)+$start_time) < time()){
	$tcp_stop=1;
	my $span = time() - $start_time;
	&do_math($f,$span);
    }
}
sub eat_tcp {
    my $ip;
    my $port;
    if (!$opt_rtmp) {
	$uri = shift;
	$port = shift;
	if ($ip  !~ /^\d+\.\d+\.\d+\.\d+$/){
	    ($ip,$port) =  prepare_ip($uri);
	}
	my $f = $ip.":".$port;
	if (! exists($tstart{$f})){
	    $tstart{$f} = [gettimeofday]; 
	    $first_us{$f}=$prev1s_us{$f}=$prevt100ms_us{$f}=$us;
	    if (! exists($setuptime{$f}) ){
		if ( $pinterval){
		    $setuptime{$f}=0;
		} else {
		    $setuptime{$f}=tv_interval ( $tjoined{$f}, $tstart{$f}) * 10**3;
		}
		printf "setup $f : %.3f\n",  $setuptime{$f} if $opt_debug;
	    }
	}
    }
    $ip = $rtmp_addr if $opt_rtmp;
    $port = 1935 unless $port;
    my ($net, $netmask, $filter_t, $err, $dev);
    #my $time_out_ms = ($opt_last*10**3) || ($opt_period*10**3) if !$opt_last;
    my $time_out_ms = 2000;
    my $filter_str = "( (src $ip and port $port ) )";
    $dev = Net::Pcap::lookupdev(\$err);  # find a device	
    my $r = Net::Pcap::lookupnet( $dev, \$net, \$netmask, \$err);
    my $pcap = Net::Pcap::open_live($dev, 1514, 1, $time_out_ms, \$err) || die "You need to run this as sudo $err";
    $r=Net::Pcap::compile($pcap, \$filter_t, $filter_str, 0,$netmask);
    $r=Net::Pcap::setfilter($pcap, $filter_t);
    while (my $pkt=Net::Pcap::next($pcap,\%hdr)) { # get all packets
	
	my $ip_obj = NetPacket::IP->decode(eth_strip($pkt));
	my $tcp_obj = NetPacket::TCP->decode(ip_strip(eth_strip($pkt)));
	if($tcp_obj->{src_port} == $port && $ip_obj->{src_ip} eq $ip ){
	    my $f = $ip_obj->{src_ip}.":".$tcp_obj->{src_port};
	    check_period($f) if $opt_last;
	    last if $tcp_stop==1;
	    &tcp_packet_stats($pkt);
	}
    }
}
##RTMP impl. -PMM
sub rtmp_eat_stream {
    ($rtmp,$period,$last,$reconnect,$debug,$swfurl,$pageurl,$flash_version) = @_;
    ($address, $app, $play) = rtmp_prepare_url($rtmp);
    $rtmp_addr = $address;
    $port = 1935 unless $opt_port;
    my $f = $address.":".$port;
    while(!$endstream){
	$start_time = time();
	if (! exists($tstart{$f})){
	    $tstart{$f} = [gettimeofday]; 
	    $first_us{$f}=$prev1s_us{$f}=$prevt100ms_us{$f}=$us;
	    if (! exists($setuptime{$f}) ){
		if ( $pinterval){
		    $setuptime{$f}=0;
		} else {
		    $setuptime{$f}=tv_interval ( $tjoined{$f}, $tstart{$f}) * 10**3;
		}
		printf "setup $f : %.3f\n",  $setuptime{$f} if $opt_debug;
	    }
	}
	$thr = threads->new(\&eat_tcp) if $opt_tcp and !$reconnect;
	rtmp_connect($address, '1935', $app , $swfurl, $pageurl,$flash_version) if $opt_rtmp;
	rtmp_play($play, '-1.0', '-1.0', $period, $last,$debug)  if $opt_rtmp;
	&display_stats() if ($opt_period != $opt_last) and !$endstream;
	my $pkt_stat = $thr->join if $opt_tcp;
	last if  $endstream;
	
    }
}


sub rtmp_prepare_url{
    my $uri = shift;
    #	return 0  if $uri != m/^(rtmp)://; 
    $uri =~ s/^(rtmp)://;
    $uri =~ s#//##;
    @string = split(/\//, $uri);
    my $length = $#string;
    my $host = $string[0];
    my $app = '';
    if ($host !~ /^\d+\.\d+\.\d+\.\d+$/){ # hostname
	my $padr=gethostbyname($host) || die "Gethostbyname - $host - $padr : $!";
	$address=Socket::inet_ntoa($padr);
    }    
    for (my $i = 1; $i < $length;$i++){
	$app .= $string[$i];
	if ($i > 1 ){$app .="/";}
    }
    my $play = $string[$length];
    return ($address,$app,$play)
}
#------------------------------------------------------------------------------

# unpack uri's to ip-address
sub prepare_ip {
    my $uri=shift;
    $uri =~ s/^(udp|rtp|http)://;
    $uri =~ s#//##;
    die "Unsupported streaming $1" if $uri =~/^(\w:)/;
    if ($multicast = ($uri =~ /@/)){
	($source, $uri)=split(/@/, $uri);
    }

    my ($host, $port)=split(/[\/:]/, $uri);
    die $usage . "undefined address inn $host" unless (defined $host);
    $port = $DEFAULT_PORT unless (defined $port);
    my $address=$host;
    if ($host !~ /^\d+\.\d+\.\d+\.\d+$/){ # hostname
	my $padr=gethostbyname($host) || die "Gethostbyname - $host - $padr : $!";
	$address=Socket::inet_ntoa($padr);
    }   
    my @nib=split(/\./,$address);
    $multicast = $multicast || $nib[0] >= 224 && $nib[0] <= 240;
    return ($address, $port, $multicast);

}

sub eat_stream {
    my $id=shift;
    $tstart{$id}=[gettimeofday];
    if ($opt_net && $opt_rtp){
	# Create RTP socket
	my $elapsed=0;
	my $t0=0.0;
	$n_packets=0;
	my ($address, $port, $multicast) = prepare_ip($id);
	my $rtp = new Net::RTP( LocalPort=>$port,
				LocalAddr=>$address ) || die "Failed to create RTP socket: $!";
	my $select=IO::Select->new($rtp->fileno);

	my $tjoined=[gettimeofday];
	if ($opt_align){ # align to $opt_period
	}

	while ($uninterrupted && !($opt_packets && $n_packets > $opt_packets)) {
	    my $packet;
	    last if ! $uninterrupted || $endstream;
	    if ($select->can_read($timeout) && ($packet = $rtp->recv())){
	    my $timeout=$next_wait; 
		my $ssrc = $packet->ssrc();
		$cur_id=$packet->source_ip . ", $address:$port";

		if ( !$file{$cur_id}){
		    push(@myflows, $cur_id);
		    $file{$cur_id}=$id;
		}
		$n_packets++;
		next if $opt_src and $opt_src ne $cur_id;

		$tc=[gettimeofday]; # current flow time
		if( $t0){
		    $elapsed=tv_interval ( $t0, $tc);
		} else {
		    $t0 = $tc;
		    $elapsed=0.0;
		    &init_stats($cur_id);
		}
		$us=$elapsed*10**6;
		$tjoined{$cur_id} = $tjoined if !$tjoined{$cur_id};
		# No stats for that SSRC yet?
		&pkt_stats($cur_id, $packet->encode, $us, $packet->size());
		
		if ($opt_dump){
		    print DUMP $packet;
		}
	    } else { # anticipate interrupted by alarm	
#		warn "Failed to receive $n_packets packets from $address:$port : $!";
#		next; #### exit
	    }
	}
#	&display_stats();

#	$mc->shutdown; # gives error message

    } elsif ($opt_net) {			# udp stream

	# Create UDP socket
	my $elapsed=0;
	my $t0=0.0;
        $n_packets=0;
	my ($address, $port, $multicast) = prepare_ip($id);
	my $mc;

	if ( $multicast){
	    $mc = IO::Socket::Multicast->new(LocalPort=>$port, LocalAddr=>$address, ReuseAddr=>1) ||
		die "Could not connect to port $port : $!";
	    $mc->mcast_add($address) || die "could not join $address:$port : $!";
	} else { # unicast
	    $mc = IO::Socket::INET->new( LocalAddr=> $address, LocalPort => $port);
	}
	my $tjoined=[gettimeofday];

	my $select=IO::Select->new($mc->fileno);

	if ($opt_align){ # align to $opt_period
	}

	#while ($uninterrupted && !($opt_packets && $n_packets > $opt_packets)){
	while ($uninterrupted && ! $endstream && !($opt_packets && $n_packets > $opt_packets)){
 		if ($select->can_read($timeout) && $mc->recv($packet, 1560)) {
		my $timeout=$next_wait; 
		$n_packets++;
		my $ssrc = $mc->peerhost;
		my $cur_id = $mc->peerhost . ":" . $mc->peerport  . "->$address:$port";
		if ( !$file{$cur_id}){
		    push(@myflows, $cur_id);
		    $file{$cur_id}=$id;
		}
		
		next if $opt_src and $opt_src ne $cur_id;

		$tc=[gettimeofday]; # current flow time
		if( $t0){
		    $elapsed=tv_interval ( $t0, $tc);
		} else {
		    $t0 = $tc;
		    $elapsed=0.0;
		    &init_stats($cur_id);
		}
		$us=$elapsed*10**6;
		$tjoined{$cur_id} = $tjoined if !$tjoined{$cur_id};
		# No stats for that SSRC yet?
		&pkt_stats($cur_id, $packet, $us, length($packet));
		if ($opt_dump){
		    print DUMP $packet;
		}
		last if ! $uninterrupted || $endstream;
		$endstream = tv_interval($t0, $tc) >= $opt_last if $opt_last && !$endstream;
	    } else { # assume that we got an interrupt
#		die "Failed to receive packet: $!"; 
	    }
	}
#	&display_stats();
#        $mc->mcast_drop($address);

    } else {			# files
	my $f=$id;
	my $pcap; 
	my $tmp_file;

	my $pcap_file=$f;
	if ($f =~ /\.gz$|\.Z/){ # gzipped ?
	    $tmp_file="/tmp/pcap$$";
	    $pcap_file=$tmp_file;
	    system( "/bin/zcat $f > $tmp_file") ; # rc code ? || die "Could not unpack $f to $tmp_file : $!";
	}
	if ($opt_crude){
	    my $flow_key;
	    open CRUDE, "<$pcap_file" || die "Could not open $f : $err";
	    while(<CRUDE>){  # crude.sourceforge.net
		my $tx0;
		
		if (($fid, $seq, $src, $dst, $tx, $rx, $size)=
		    /ID=(\d+)\s+SEQ=(\d+)\s+SRC=([\d.:]+)\s+DST=([\d.:]+)\s+Tx=([\d.,]+)\s+Rx=([\d.,]+)\s+SIZE=(\d+)/){

		    $flow_key="$src->$dst";
		    $flow_pkts{$flow_key}++;
		    $tc=[int($rx), ($tx-int($rx))*10^6] ; # tval
		    if ($flow_pkts{$flow_key} <= 1) { # new flow
			push(@flows, $flow_key);  # 
			$flow_no++; 
			$file{$flow_key}=$f;
			$source{$flow_key}=$src;
			$rx0{$flow_key}=$rx;
			$tx0{$flow_key}=$tx;
			$tjoined{$flow_key}=$tc;
		    } 
		    
		    next if $opt_list;  # just count packets per flow
		    next if $opt_flow_key && $flow_key !~ $wanted_flow;
		    next if $opt_flow_no && $opt_flow_no !~ /\b$flow_no\b/;
		    
		    if ($flow_pkts{$flow_key} <= 1) { #
			&init_stats($flow_key);
			push (@myflows, $flow_key);
		    }

		    $seq_num{$flow_key}=$seq;
		    $ptx{$flow_key}=$tx{$flow_key}; # previous
		    $tx{$flow_key}=$tx;
		    $rx{$flow_key}=$rx;
		    $mtime{$flow_key}=($tx-$tx0{$flow_key})*10**6;
		    $us=($rx-$rx0{$flow_key})*10**6; # us
		    &pkt_stats($flow_key, 0, $us, $size);
		}
	    }
	    
	} else {
	    if ($pcap=Net::Pcap::open_offline($pcap_file, \$err)){ 
		#	my $select=IO::Select->new(Net::Pcap::fileno($pcap));
		until ( ! $uninterrupted || $endstream || ($opt_packets && $n_packets > $opt_packets) 
			|| ! (my $pkt=Net::Pcap::next($pcap, \%hdr) ) ) {
		    #$file_flag =1;
		    $offline =1;
		    eat_pcap($f, $pcap, $pkt);
		    $n_packets++;
		}
		printf "%s\n", $ttl_log if  $opt_ttl;

	    } else { # open failed 
		if ($format ne "full"){ # always put out data when format full
		    die "Could not open $f : $err";
		}
	    }
	}
	undef $t0;
	unlink $tmpfile if $tmp_file;
    } # of files
} # of eat_stream


sub eat_pcap_streams{ # open groups and listen on pcap
    my @streams=@_; 
    my $filter="( ";
    my ($address, $port, $multicast);
    my $mc = IO::Socket::Multicast->new(LocalPort=>$DEFAULT_PORT, ReuseAddr=>1) ||
	die "Could not connect to port $port : $!";
    foreach $id (@streams){ # listen to all groups
	if ($opt_ipv6){
	    $address = Net::IPv6Addr::ipv6_parse($id);
	    $port =  $opt_p;
	}
	else {
	    ($address, $port, $multicast) = prepare_ip($id);
	}
	$filter .= " or " if $filter =~ /\(\s+\(/;
	if ($multicast){
	    $mc->mcast_add($address) || die "could not join $address:$port : $!";
	    $filter .= "(dst $address and port $port)"; 	
	} else {
	    $filter .= "(src $address and port $port)"; 
	}
    }
    $tjoined{$f}=[gettimeofday];
    $filter .= " )";
#    $filter .= " and ip multicast";
#    $filter ="ip";
    my ($net, $netmask, $filter_t, $err, $dev);
#    printf $filter;
    $dev = Net::Pcap::lookupdev(\$err) || die "Could not lookupdev $dev : $err : $! .. Needs to run as sudo ..";
    my $r = Net::Pcap::lookupnet( $dev, \$net, \$netmask, \$err);
    die "Failed lookupnet for $dev : $r : $err : $!" if $r != 0;
    my $snap_length = 100;
    $snap_length = 1514 if $opt_mpeg;
    $pcap=Net::Pcap::open_live( $dev, $snap_length, 1, 0,\$err) || die "Could not open $dev  : $err";
    $r=Net::Pcap::compile($pcap, \$filter_t, $filter, 0, $netmask);
    die "Could not compile filter : $r : $filter : $!)" if $r != 0;
    $r=Net::Pcap::setfilter($pcap, $filter_t);
    die "Could not set pcap filter : $r : $filter : $! " if $r != 0 ;
    my $select=IO::Select->new( Net::Pcap::fileno($pcap));
    while ($select->can_read($timeout) && (my $pkt=Net::Pcap::next($pcap, \%hdr)) ) { # get all packets
	last if ! $uninterrupted || $endstream;
	eat_pcap("pcap", $pcap, $pkt);
	$n_packets++;
	last if  $opt_packets && $n_packets > $opt_packets;
    }
    printf "%s\n", $ttl_log if  $opt_ttl;

}

sub set_network_info{
    my ($f,$src_ip,$src_port,$dst_ip,$dst_port) = @_;
    $network_info{$f}{'src_ip'} = $src_ip;
    $network_info{$f}{'dst_ip'} = $dst_ip;
    $network_info{$f}{'src_port'} = $src_port;
    $network_info{$f}{'dst_port'} = $dst_port;	
}
sub eat_pcap { # process pcap packets	
    my ($f, $pcap, $pkt)=@_;
    my $ip=null;
    my $ip_payload;# udp or tcp packet.
    my $rtp = new Net::RTP::Packet(); # spare rtp obj
    my $proto,$len=null;
    if (Net::Pcap::datalink($pcap) == 1){ # ethernet
    	if ($opt_ipv6){
	    $ip = NetPacket::IPv6->decode(eth_strip($pkt));
	    $proto = $ip->{nxt};
	    $len = plen;
	    $hlen =  0;
	}
	else {
	    $ip = NetPacket::IP->decode(eth_strip($pkt));
	    $proto = $ip->{proto};
	    $len = len;
	    $hlen = ($ip->{hlen}*4);
	}
    } elsif (Net::Pcap::datalink($pcap) == 113) { # DLT_LINUX_SLL
	my ($head, $data)=unpack('a16a*', $pkt);  
	$ip = NetPacket::IP->decode($data);
    } else {
	die "Invalid link layer type : ".Net::Pcap::datalink($pcap);
    }
    
    if ($proto == IP_PROTO_TCP){
    	$opt_tcp = 1; 
	$ip_payload = NetPacket::TCP->decode($ip->{data});
    }
    else {
    	$ip_payload = NetPacket::UDP->decode($ip->{data});
    }
    my $dlen = $ip->{$len} - $hlen;
    my $flow_key;
    if ($opt_sum){
	$flow_key=$opt_sum;
    }
    elsif ($file_flag){
    	$flow_key = $f;
    }
    else {
	$flow_key=sprintf "%s:%d->%s:%d", 
        $ip->{src_ip}, $ip_payload->{src_port}, $ip->{dest_ip}, $ip_payload->{dest_port};
    }
    set_network_info($f,$ip->{src_ip}, $ip_payload->{src_port}, $ip->{dest_ip}, $ip_payload->{dest_port});
    $flow_pkts{$flow_key}++;
    #next if $ip->{proto} != IP_PROTO_UDP;
    if ($flow_pkts{$flow_key} <= 1) { # new flow
	push(@flows, $flow_key);  # 
	$flow_no++; 
	$file{$flow_key}=$f;
	$source{$flow_key} =sprintf "%s:%d", $ip->{src_ip}, $ip_payload->{src_port};
    }
    if ($opt_ttl){
	if ($pttl{$flow_key} && ($opt_log ||  ($pttl{$flow_key} !=  $ip->{ttl}))){ # change in ttl
	    printf "%s\n",  $ttl_log;
	    $nttl{$flow_key}=0;		
	}
	$pttl{$flow_key}= $ip->{ttl};
	$nttl{$flow_key}++;
	($sequence_number{$flow_key}, $tx_time_seconds{$flow_key}, $tx_time_useconds{$flow_key}, $flow_id{$flow_key})= unpack('NNNN', $ip_payload->{data});
	$ttl_log=sprintf "ID=%u SEQ=%u SRC=%s DST=%s Tx=%u.%06u  Rx=%u.%06u TTL=%u",  
	$flow_id{$flow_key}, $sequence_number{$flow_key}, 
	$ip->{src_ip}, $ip->{dest_ip}, $tx_time_seconds{$flow_key}, 
	$tx_time_useconds{$flow_key}, $hdr{tv_sec}, $hdr{tv_usec}, $pttl{$flow_key};
	$ttl_log.= sprintf(" No=%08d\n",  $nttl{$flow_key},) if !$opt_log;
    }
    next if $opt_list;  # just count packets per flow
    next if $opt_flow_key && $flow_key !~ $wanted_flow;
    next if $opt_flow_no && $opt_flow_no !~ /\b$flow_no\b/;

    if ($flow_pkts{$flow_key} <= 1) { #
	&init_stats($flow_key);
	push (@myflows, $flow_key);
    }
    $tc= [$hdr{tv_sec}, $hdr{tv_usec}];
    if (! defined($t0)) {
	$t0=$tc;
    }
    $tjoined{$f}=$tc if !$tjoined{$f};
    $tjoined{$flow_key} = $tjoined{$f} if !exists($tjoined{$flow_key});
    $us = tv_interval ( $t0, $tc) * 10**6 ; # us relative packet time 	  
# fixate on first flow to appear
#    if ( $first_port) {
#	next if $ip_payload->{dest_port} != $first_port;
#    } else {
#	$first_port =  $ip_payload->{dest_port};
#    }
    if ($opt_tcp){
	&tcp_packet_stats($flow_key,$ip,$ip_payload);
    }
    &pkt_stats($flow_key, $ip_payload->{data}, $us, $dlen);
}

#--------------------------------------------------------------------------------
sub init_stats {
    my $f=shift;
    $pinterval=0;
    $npkt{$f}=$sumbyte{$f}=$ssbyte{$f}=0;
    $first_sec=0;
    delete $pmtime{$f}; delete $pus{$f} ; delete $first_us{$f};  delete $last_us{$f}; 
#pmm delete $prev_1s{$f}; delete $prev_100ms{$f}; 
    delete $per1s{$f}; delete $per100ms{$f};
#pmm delete $sum1s{$f}; delete $sum100ms{$f};
    $n100ms{$f}=0; $sum100ms{$f}=0; $ss100bps{$f}=0; $akk100ms{$f}=0;
    $sumbyte{$f}=$sumps{$f}=0;			# sum byte per second
    $maxbps{$f}=0; $max100ms{$f}=0;
    $dup{$f}=$lost{$f}=$late{$f}=0;
    $maxbyte{$f}=0; $minbyte{$f}=2**31;
    $sumgap{$f}=$ssgap{$f}=0;
    $ngap{$f}=0; $maxgap{$f}=0, $mingap{$f}=2**63-5;
    $njitter{$f}=$sumjitter{$f}=$ssjitter{$f}=0;
    $maxjitter{$f}=-2**63-5; $minjitter{$f}=2**63-5; delete $est_jitter{$f}; delete $pest_jitter{$f}; 
    $first_port = 0;  $n_seq=-1;
    delete $tstart{$f}; delete $tend{$f}; 
    

#MPEG-TS initalizing and resetting (new period!)
    
    $discontinuities = 0;
    %last_ccs = ();
    %mpeg_stats = ();
    @cc = ();
# r_stats {filename/handle}
    @pcr_stats{$f} = ();
#P-stats {filename/handle}
    @pts_stats{$f,$TS} = ();
    @mpeg_stats{$f} = ();
#P stuff
    $late_video_packets = 0;
#MPEG-TS END
    %dist1 = ();
    %dist2 = ();
    $num_cc = 0;
}
sub format_numbers{
    my $value =  shift;
    if ($value =~ /^[a-zA-z][\D]*$/ || $value  !~ /^\d+\.\d+$/) {
	return sprintf("%1.0f",$value);
    }
    else {
	return sprintf("%0.2f",$value);
    }
}
sub xml_dump_rtmp_tcp {
    my $f = $_[0];  # *Not* shift. This gets called from a signal handler.
    return 0 if $xml_printed;
    my ($rtmp_jitter_stats,$rtmp_stats,$span)  = get_rtmp_data() if $opt_rtmp;
    my ($tcp_packet_stats) = (\%tcp_packet_stats) if $opt_tcp;
    my $xml_version="1.0";
    if ($period_num <= 1 ){
	$doc = XML::DOM::Document->new;
    	my $decl = $doc->createXMLDecl('1.0');
	$doc-> setXMLDecl($decl);
	$qstream = $doc->createElement('qstream');
	$qstream->setAttribute('version',$xml_version);
	$doc->appendChild($qstream);
    }
    ($address,$app,$play) = rtmp_prepare_url($f) if $rtmp;
    #($address, $port) = prepare_ip($f) if $opt_tcp && !$opt_rtmp;
    #$port  = 1935 unless $opt_port;
    #my $id=$address.":".$port;
    my $id = $f;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($tstart{$f}->[0]);
    my $time=sprintf "%02d:%02d:%02d", $hour, $min, $sec;
    my $date=sprintf "%4d-%02d-%02d", $year+1900, $mon+1, $mday;
    my $span=&tv_interval($tstart{$f}, $tend{$f}); # second
    &do_math($id,$span);
    my $flow = $doc->createElement('flow');
    my $flow_id = $doc->createElement('flow_id');
    my $rtmp_stats_xml  = $doc->createElement('rtmp_stats');
    my $dateXML = $doc->createElement('date');
    my $timeXML = $doc->createElement('time');
    my $spanXML = $doc->createElement('span'); 
    $qstream->appendChild($flow);
    $flow->appendChild($flow_id);
    $flow->appendChild($dateXML);
    $flow->appendChild($timeXML);
    $flow->appendChild($rtmp_stats_xml) if $opt_rtmp;
    $rtmp_stats_xml->appendChild($spanXML);    

    #source and destination ip. 
    $flow_id->addText($id);
    
    #datetime 
    $dateXML->addText($date);
    $timeXML->addText($time);
    $spanXML->addText($span);

    if ($opt_rtmp) {
	for my $k1 ( sort keys %$rtmp_stats ) {
	    my $element = $doc->createElement($k1);	
	    $rtmp_stats_xml->appendChild($element);
	    $element->addText(&format_numbers($rtmp_stats->{ $k1 }));	
	}
	foreach $k1 (sort keys %$rtmp_jitter_stats ){
	    if ($rtmp_jitter_stats->{ $k1 }{ 'type' } eq "Video" || $rtmp_jitter_stats->{ $k1 }{ 'type'} eq "Audio" ){
		my $chunk = $doc->createElement('chunk');
		$chunk->setAttribute('id', $k1);
		$rtmp_stats_xml->appendChild($chunk);
		for my $k2 (sort keys %{$rtmp_jitter_stats->{ $k1 }} ) {
		    my $element = $doc->createElement($k2);
		    $chunk->appendChild($element);
		    $value = &format_numbers($rtmp_jitter_stats->{ $k1 }{ $k2 }); 
		    $element->addText(&format_numbers($value));
		}   
	    }     
	}
    }
    #bandwidth	
    if ($opt_tcp){
    	$f = $id;
    	my $bw_stats = $doc->createElement('bandwidth_stats');
	my $avg_bw = $doc->createElement('bandwidth_avg');
    	my $max_bw = $doc->createElement('bandwidth_max_1s');
	my $max_bw_100ms = $doc->createElement('bandwidth_max_100ms');
    	my $sdv_bw = $doc->createElement('bandwidth_sdv');
    	$flow->appendChild($bw_stats);
    	$bw_stats->appendChild($avg_bw);
    	$bw_stats->appendChild($max_bw);
    	$bw_stats->appendChild($max_bw_100ms);
    	$bw_stats->appendChild($sdv_bw);
    	$avg_bw->addText(&format_numbers( avg( $bw_stats{$f}{'sumbyte'}*8, $span )));
	$max_bw->addText(&format_numbers($bw_stats{$f}{'maxbps'}));
	$max_bw_100ms->addText(&format_numbers($bw_stats{$f}{'max100ms'}));
	$sdv_bw->addText(&format_numbers(sdv($bw_stats{$f}{'n100ms'},
					     $bw_stats{$f}{'akk100ms'}, 
					     $bw_stats{$f}{'ss100bps'})));
    	my $child = $doc->createElement('tcp_packet_stats');
    	$flow->appendChild($child);
	for my $k2 (sort keys %{$tcp_packet_stats->{ $id }} ) {
	    my $grandchild = $doc->createElement($k2);
	    $value = &format_numbers($tcp_packet_stats->{$id}{$k2});
	    $grandchild->addText($value);	
	    $child->appendChild($grandchild);
	}
    } 
    #my $final_xml = $flow->toString();
    &init_stats($id);
}

sub xml_new {
    my ($pcr_stats,$pts_stats,$mpeg_stats) = (\%pcr_stats, \%pts_stats,\%mpeg_stats) if $opt_mpeg;
    my $doc = XML::DOM::Document->new;
    my $decl = $doc->createXMLDecl('1.0');
    my $flow = $doc->createElement('flow');
    my $src_dst = $doc->createElement('src_dst');
    my $dateXML = $doc->createElement('date');
    my $timeXML = $doc->createElement('time');
    my @elements_network_stats  = qw "src_dst date time network_stats setuptime gap";
    my @elements_pcr  = qw "pcr_avg_jitter pcr_sdv_jitter pcr_jitter_min pcr_jitter_max";
    my @elements_pts  = qw "dwell_sum dwell_num";
    my @elements_rtp = qw " ";
    my $mpeg_stats_parrent = $doc->createElement('mpeg_stats');
    my $pcr_stats_parrent = $doc->createElement('pcr_stats');
    my $transport_streams = $doc->createElement('transport_streams');
    my $pts_stats_parrent = $doc->createElement('pts_stats');

    #append static childs
    $doc->appendChild($flow);
    $flow->appendChild($pcr_stats_parrent);
    $flow->appendChild($transport_streams);
    $transport_streams->appendChild($pts_stats_parrent);
    $transport_streams->appendChild($mpeg_stats_parrent);
    
    #loop through hashes
    for my $k1 ( sort keys %mpeg_stats ) {
    	for my $k2 ( keys %{$mpeg_stats->{ $k1 }} ) {
	    for my $k3 (keys %{$mpeg_stats->{ $k1 } { $k2 }}){
		#$child = $doc->createElement($k3);
		#$child->addText(&lesbar($mpeg_stats->{ $k1 }{ $k2 }{ $k3 }));
		#$mpeg_stats_parrent->appendChild($child);		
	    }
    	}
    }
    
    for my $k1 ( sort keys %$pcr_stats ) {
    	for my $k2 ( keys %{$pcr_stats->{ $k1 }} ) {
	    foreach my $element (@elements_pcr){
				if ($element eq $k2){
				    $child = $doc->createElement($k2);
				    $child->addText(&lesbar($pcr_stats->{ $k1 }{ $k2 }));
				    $pcr_stats_parrent->appendChild($child);		
				}
	    }
      	}
    }
    
    for my $k1 ( sort keys %$pts_stats ) {
    	for my $k2 ( keys %{$pts_stats->{ $k1 }} ) {
	    for my $k3 (keys %{$pts_stats->{ $k1 } { $k2 }}){
		foreach my $element (@elements_pts){
		    if ($element eq $k3){
			$child = $doc->createElement($k3);
			$child->addText(&lesbar($pts_stats->{ $k1 }{ $k2 }{ $k3 }));
			$pcr_stats_parrent->appendChild($child);		
		    }	
		}
	    }
      	}
    }
}


sub xml_dump {
    my $f = $_[0];  # *Not* shift. This gets called from a signal handler.
    return 0 if $xml_printed;
    my ($network_info) = (\%network_info);
    my ($pcr_stats,$pts_stats) = (\%pcr_stats, \%pts_stats) if $opt_mpeg;
    my $xml_version="1.0";
    if ($period_num <= 1 ){
	$doc = XML::DOM::Document->new;
    	my $decl = $doc->createXMLDecl('1.0');
	$doc-> setXMLDecl($decl);
	$qstream = $doc->createElement('qstream');
	$qstream->setAttribute('version',$xml_version);
	$doc->appendChild($qstream);
    }
    my $flow = $doc->createElement('flow');
    my $flow_id = $doc->createElement('flow_id');
    my $flow_nameXML = $doc->createElement('flow_name');
    my $dateXML = $doc->createElement('date');
    my $timeXML = $doc->createElement('time');
    my $spanXML = $doc->createElement('span');
    my $pcr_jitter_parrent = $doc->createElement('pcr_jitter') if $opt_mpeg;
    my $network_info_parrent = $doc->createElement('network_info');
    $qstream->appendChild($flow);
    $flow->appendChild($flow_id);
    $flow->appendChild($flow_nameXML);
    $flow->appendChild($dateXML);
    $flow->appendChild($timeXML);
    $flow->appendChild($spanXML);
    $flow->appendChild($pcr_jitter_parrent) if $opt_mpeg;
    my $media="file";
    $media = "host:port" if $opt_net;
    my $id=$f;
    $flow_name = $id;
    $id = $opt_id if $opt_id;
    $flow_name = $opt_name if $opt_name;
    next if $npkt{$f} < $opt_flow_min;
    my $source=$f; 
    $source=$source{$f} if  ! $opt_v && $source{$f} ne "";
    $source=$opt_id if $opt_id;
    my $jitter_stat= $opt_rtp || $opt_crude;

    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($tstart{$f}->[0]);
    my $time=sprintf "%02d:%02d:%02d", $hour, $min, $sec;
    if ($format eq "full"){
	$time.=sprintf ".%06d", $tstart{$f}->[1];
    } else {
	my $time=sprintf "%02d:%02d:%02d", $hour, $min, $sec;
    }
    my $date=sprintf "%4d-%02d-%02d", $year+1900, $mon+1, $mday;
    my $span=&tv_interval($tstart{$f}, $tend{$f}); # second
    &do_math($f,$span);
    &burst($f); # in case a second is interrupted
    #source and destination ip. 
    $flow_id->addText($id);
    $flow_nameXML->addText($flow_name);
    #datetime 
    $dateXML->addText($date);
    $timeXML->addText($time);
    $spanXML->addText($span);
    for my $k1 ( sort keys %network_info ) {
    	$flow->appendChild($network_info_parrent);
    	for my $k2 ( keys %{$network_info->{ $k1 }} ) {
		    $child = $doc->createElement($k2);
		    $child->addText($network_info->{ $k1 }{ $k2 });
		    $network_info_parrent->appendChild($child);
    	}
    }
    #network_stats
    my $network_stats = $doc->createElement('network_stats');
    my $setuptimeXML = $doc->createElement('setuptime');
    my $gap_avgXML = $doc->createElement('gap_avg');
    my $gap_sdvXML = $doc->createElement('gap_sdv');
    my $gap_minXML = $doc->createElement('gap_min');
    my $gap_maxXML = $doc->createElement('gap_max');
    $network_stats->appendChild($setuptimeXML);
    $network_stats->appendChild($gap_avgXML);
    $network_stats->appendChild($gap_sdvXML);
    $network_stats->appendChild($gap_minXML);
    $network_stats->appendChild($gap_maxXML); 
    $flow->appendChild($network_stats);
    #packets_stats
    my $packet_stats = $doc->createElement('packet_stats');
    my $packets_numbXML = $doc->createElement('packet_count');
    my $packets_sizeXML = $doc->createElement('packets_size');
    $flow->appendChild($packet_stats);
    $packet_stats->appendChild($packets_numbXML);
    
    #bandwidth
    my $bw_stats = $doc->createElement('bandwidth_stats');
    my $avg_bw = $doc->createElement('bandwidth_avg');
    my $max_bw = $doc->createElement('bandwidth_max');
    my $max_bw_100ms = $doc->createElement('bandwidth_max_100ms');
    my $sdv_bw = $doc->createElement('bandwidth_sdv');
    $bw_stats->appendChild($avg_bw);
    $bw_stats->appendChild($max_bw);
    $bw_stats->appendChild($max_bw_100ms);
    $bw_stats->appendChild($sdv_bw);
    $flow->appendChild($bw_stats);

    #network_stats
    $setuptimeXML->addText(&format_numbers($setuptime{$f}));
    $gap_avgXML->addText(&format_numbers(avg( $sumgap{$f}, $ngap{$f}) / 1000 ));
    $gap_sdvXML->addText(&format_numbers(sdv($ngap{$f}, $sumgap{$f},$ssgap{$f})/1000));
    $gap_minXML->addText(&format_numbers($mingap{$f}/1000));
    $gap_maxXML->addText(&format_numbers($mingap{$f}/1000));
    
    #Jitter / $opt_crue or $opt_rtp
    if ($jitter_stat){
	#create elements
	my $MOS_XML = $doc->createElement('MOS');
	my $rtp_timestamp = $doc->createElement('rtp_timestamp');
	my $rtp_dup = $doc->createElement('rtp_duplicated');
	my $rtp_late = $doc->createElement('rtp_pkt_late');
	my $rtp_lost = $doc->createElement('rtp_pkt_lost');
	my $rtp_gaps = $doc->createElement('rtp_pkt_gaps');
	my $rtp_avg = $doc->createElement('rtp_pkt_lost_avg');
	my $rtp_sdv = $doc->createElement('rtp_pkt_lost_sdv');
	my $rtp_jitter_numb = $doc->createElement('rtp_jitter_numb');
	my $rtp_jitter_avgXML = $doc->createElement('rtp_jitter_avg');
	my $rtp_jitter_sdvXML = $doc->createElement('rtp_jitter_sdv');
	my $rtp_jitter_minXML = $doc->createElement('rtp_jitter_min');
	my $rtp_jitter_maxXML = $doc->createElement('rtp_jitter_max');
	my $rtp_jitter_rfc = $doc->createElement('rtp_jitter_rfc');
	my $packets_dupXML = $doc->createElement('packet_duplicated');
    	my $packets_lateXML = $doc->createElement('packet_late');
    	my $packets_lostXML = $doc->createElement('packet_lost');
	my $packets_sizeXML = $doc->createElement('packet_size');
	
	#append childs
	$network_stats->appendChild($MOS_XML);
	$network_stats->appendChild($rtp_timestamp);
	$network_stats->appendChild($rtp_dup);
	$network_stats->appendChild($rtp_late);
	$network_stats->appendChild($rtp_lost);
	$network_stats->appendChild($rtp_gaps);
	$network_stats->appendChild($rtp_avg);
	$network_stats->appendChild($rtp_sdv);
	$network_stats->appendChild($rtp_jitter_numb);
	$network_stats->appendChild($rtp_jitter_avgXML);
	$network_stats->appendChild($rtp_jitter_sdvXML);
	$network_stats->appendChild($rtp_jitter_minXML);
	$network_stats->appendChild($rtp_jitter_maxXML);
	$network_stats->appendChild($rtp_jitter_rfc);
	
	$packet_stats->appendChild($packets_dupXML);
    	$packet_stats->appendChild($packets_lateXML);
    	$packet_stats->appendChild($packets_lostXML);
    	$packet_stats->appendChild($packets_sizeXML);
    	
    	$packets_dupXML->addText(&format_numbers($dup{$f}));
	$packets_lateXML->addText(&format_numbers($late{$f}));
	$packets_lostXML->addText(&format_numbers($nloss{$f}));
	my $n=$npkt{$f}; $n=1 if $npkt{$f} < 1; # divide by zero protection
	my $njitter = $njitter{$f}; $njitter =1 if $njitter{$f} < 1;
	$packets_sizeXML->addText(&format_numbers($sumbyte{$f}/$n));
	
	#adds values
	$MOS_XML->addText(&format_numbers(&mos_r($codec, $rtt,  avg( $sumgap{$f}, $ngap{$f}) / 1000,
						 avg($sumjitter{$f}, $njitter)/1000, 
						 100*$nloss{$f}/$n)));
	
	$rtp_timestamp->addText(&format_numbers($ntimeerr{$f}));
	$rtp_dup->addText(&format_numbers($dup{$f}));
	$rtp_late->addText(&format_numbers($late{$f}));
	$rtp_lost->addText(&format_numbers($lost{$f}));
	$rtp_gaps->addText(&format_numbers($nloss{$f}));
	$rtp_avg->addText(&format_numbers( avg( $sumloss{$f}, $nloss{$f}) ));
	$rtp_sdv->addText(&format_numbers( sdv($lost{$f}, $sumloss{$f},$ssumloss{$f})));
	$rtp_jitter_numb->addText(&format_numbers($njitter{$f}));			
	$rtp_jitter_avgXML->addText(&format_numbers($sumjitter{$f}/$njitter/1000));
	$rtp_jitter_sdvXML->addText(&format_numbers($sumjitter{$f}/$njitter/1000));
	$rtp_jitter_minXML->addText(&format_numbers($minjitter{$f}/1000));
	$rtp_jitter_maxXML->addText(&format_numbers($maxjitter{$f}/1000));
	$rtp_jitter_rfc->addText(&format_numbers($maxjitter{$f}/1000));
    }	
    #packet stats
    
    $packets_numbXML->addText(&format_numbers($npkt{$f}));
    #$packets_sizeXML->addText();

    #bandwidth	
    $avg_bw->addText(&format_numbers( avg( $sumbyte{$f}*8, $span )));
    $max_bw->addText(&format_numbers($maxbps{$f}));
    $max_bw_100ms->addText(&format_numbers($max100ms{$f}));
    $sdv_bw->addText(&format_numbers(sdv($n100ms{$f},
					 $akk100ms{$f}, 
					 $ss100bps{$f})));	
    if ($opt_mpeg) {			
	#PCR_stats
	my $pcr_jitter_avg_XML = $doc->createElement('pcr_jitter_avg');
	my $pcr_jitter_sdv_XML = $doc->createElement('pcr_jitter_sdv');
	my $pcr_jitter_min_XML = $doc->createElement('pcr_jitter_min');
	my $pcr_jitter_max_XML = $doc->createElement('pcr_jitter_max');
	$pcr_jitter_avg_XML->addText(&format_numbers( (10**3) * avg($pcr_stats{$f}{$pcr_pid{$f}}{'pcr_jitter_sum'}, $pcr_stats{$f}{$pcr_pid{$f}}{'num'})));
	$pcr_jitter_sdv_XML->addText(&format_numbers( (10**3) * sdv($pcr_stats{$f}{$pcr_pid{$f}}{'num'}, $pcr_stats{$f}{$pcr_pid{$f}}{'pcr_jitter_sum'},$pcr_stats{$f}{$pcr_pid{$f}}{'pcr_jitter_square'})));
	$pcr_jitter_min_XML->addText(&format_numbers( (10**3) * $pcr_stats{$f}{$pcr_pid{$f}}{'min_jit'}));
	$pcr_jitter_max_XML->addText(&format_numbers( (10**3) * $pcr_stats{$f}{$pcr_pid{$f}}{'max_jit'}));
	
	$pcr_jitter_parrent->appendChild($pcr_jitter_avg_XML);
	$pcr_jitter_parrent->appendChild($pcr_jitter_sdv_XML);
	$pcr_jitter_parrent->appendChild($pcr_jitter_min_XML);
	$pcr_jitter_parrent->appendChild($pcr_jitter_max_XML);
    }
    #Transport stream, goes throu @transport_streams for vidoe and audiostreams.
    if ($opt_mpeg){
    	
	
	if(!@filter){
		my $transport_stream = $doc->createElement('transport_stream');
		my $pid_XML = $doc->createElement('pid');
		my $stream_id_XML = $doc->createElement('stream_id');
		my $stream_id_type_XML = $doc->createElement('stream_id_type');
		my $num_packets_XML = $doc->createElement('mpeg_packets');
		my $lost_packets_XML = $doc->createElement('mpeg_lost_packets');
		my $media_loss_rate_XML = $doc->createElement('media_loss_rate');
		my $delay_factor_XML = $doc->createElement('delay_factor');
		my $media_bandwidth_XML = $doc->createElement('media_bandwidth');
		#my $lost_packets_XML = $doc->createElement('mpeg_lost_packets');
		my $dwell_avg_XML = $doc->createElement('dwell_avg');
		my $dwell_sdv_XML = $doc->createElement('dwell_sdv');
		my $dwell_min_XML = $doc->createElement('dwell_min');
		my $dwell_max_XML = $doc->createElement('dwell_max');
		#append childs.
		$flow->appendChild($transport_stream);
		$transport_stream->appendChild($pid_XML);
		$transport_stream->appendChild($stream_id_XML);
		$transport_stream->appendChild($stream_id_type_XML);
		$transport_stream->appendChild($num_packets_XML);
		$transport_stream->appendChild($lost_packets_XML);
		$transport_stream->appendChild($media_loss_rate_XML);
		$transport_stream->appendChild($media_bandwidth_XML);
		$transport_stream->appendChild($dwell_avg_XML);
		$transport_stream->appendChild($dwell_sdv_XML);
		$transport_stream->appendChild($dwell_min_XML);
		$transport_stream->appendChild($dwell_max_XML);
		$transport_stream->appendChild($delay_factor_XML);
		my $mpeg_pid = 0;
	    my $pts_pid = 0 ;
	    my $max = 0;
	    my $max_pts = 0;
	    
#		Finds the PES with the most mpeg-packets. If the PES dont contains PTS and PCR. Use the PES with the 
#		highest number of PTS. 
	    for my $pid ( sort keys %{$pts_stats->{ $f }}  ) {
	    	if($mpeg_stats{$f}{$pid}{'num'} > $max){
	    		$mpeg_pid = $pid;
	    		$max = $mpeg_stats{$f}{$pid}{'num'};
	    	}
	    	if($pts_stats{$f}{$mpeg_pid}{'dwell_sum'} > 0){
	    		$pts_pid = $mpeg_pid;
	    	}
	    	elsif($pts_stats{$f}{$pid}{'num'} > $max_pts){
	    		$pts_pid = $pid;
	    		$max_pts = $pts_stats{$f}{$pid}{'num'};
	    	}
	    }
	    my $delay_factor = ((($mpeg_stats{$f}{$mpeg_pid}{'avg_packets_1s'} * $pts_stats{$f}{$pts_pid}{'dwell_avg'}*(10**-3))*188)/$mpeg_stats{$f}{$mpeg_pid}{'media_bandwidth'})*(10**2);
		$pid_XML->addText($mpeg_pid);	    
		#PES and PTS_stats
		$stream_id_XML->addText($pts_stats{$f}{$pts_pid}{'stream_id'});
		$stream_id_type_XML->addText($pts_stats{$f}{$pts_pid}{'stream_id_type'});
		#mpeg
		$num_packets_XML->addText($mpeg_stats{$f}{$mpeg_pid}{'num'});
		$lost_packets_XML->addText(&format_numbers($mpeg_stats{$f}{$mpeg_pid}{'lost_packets'}));
		$media_loss_rate_XML->addText(&format_numbers($mpeg_stats{$f}{$mpeg_pid}{'media_loss_rate'}));
		$delay_factor_XML->addText(&format_numbers($delay_factor));
		$media_bandwidth_XML->addText(&format_numbers($mpeg_stats{$f}{$mpeg_pid}{'media_bandwidth'}));
		#dwell time
		$dwell_avg_XML->addText(&format_numbers( (10**3) * avg($pts_stats{$f}{$pts_pid}{'dwell_sum'}, $pts_stats{$f}{$pts_pid}{'num'})));
		$dwell_sdv_XML->addText(&format_numbers( (10**3) * sdv($pts_stats{$f}{$pts_pid}{'num'}, 
								       $pts_stats{$f}{$pts_pid}{'dwell_sum'}, 
								       $pts_stats{$f}{$pts_pid}{'dwell_squared'}))),
		$dwell_min_XML->addText(&format_numbers( (10**3) * $pts_stats{$f}{$pts_pid}{'min_dwell'}));
		$dwell_max_XML->addText(&format_numbers( (10**3) * $pts_stats{$f}{$pts_pid}{'max_dwell'}));
	}
	
	for my $pid ( sort keys %{$pts_stats->{ $f }}  ) {
	    if ( grep { $_ eq $pts_stats->{ $f }{ $pid }{ 'stream_id_type'} || $_ eq 'all'} @filter) {
	    my $transport_stream = $doc->createElement('transport_stream');
		my $pid_XML = $doc->createElement('pid');
		my $stream_id_XML = $doc->createElement('stream_id');
		my $stream_id_type_XML = $doc->createElement('stream_id_type');
		my $num_packets_XML = $doc->createElement('mpeg_packets');
		my $lost_packets_XML = $doc->createElement('mpeg_lost_packets');
		my $media_loss_rate_XML = $doc->createElement('media_loss_rate');
		my $delay_factor_XML = $doc->createElement('delay_factor');
		my $media_bandwidth_XML = $doc->createElement('media_bandwidth');
		#my $lost_packets_XML = $doc->createElement('mpeg_lost_packets');
		my $dwell_avg_XML = $doc->createElement('dwell_avg');
		my $dwell_sdv_XML = $doc->createElement('dwell_sdv');
		my $dwell_min_XML = $doc->createElement('dwell_min');
		my $dwell_max_XML = $doc->createElement('dwell_max');
		#append childs.
		$flow->appendChild($transport_stream);
		$transport_stream->appendChild($pid_XML);
		$transport_stream->appendChild($stream_id_XML);
		$transport_stream->appendChild($stream_id_type_XML);
		$transport_stream->appendChild($num_packets_XML);
		$transport_stream->appendChild($lost_packets_XML);
		$transport_stream->appendChild($media_loss_rate_XML);
		$transport_stream->appendChild($media_bandwidth_XML);
		$transport_stream->appendChild($dwell_avg_XML);
		$transport_stream->appendChild($dwell_sdv_XML);
		$transport_stream->appendChild($dwell_min_XML);
		$transport_stream->appendChild($dwell_max_XML);
		$transport_stream->appendChild($delay_factor_XML);
		#set id 
		$pid_XML->addText($pid);	    
		#PES and PTS_stats
		$stream_id_XML->addText($pts_stats{$f}{$pid}{'stream_id'});
		$stream_id_type_XML->addText($pts_stats{$f}{$pid}{'stream_id_type'});
		#mpeg
		$num_packets_XML->addText($mpeg_stats{$f}{$pid}{'num'});
		$lost_packets_XML->addText(&format_numbers($mpeg_stats{$f}{$pid}{'lost_packets'}));
		$media_loss_rate_XML->addText(&format_numbers($mpeg_stats{$f}{$pid}{'media_loss_rate'}));
		$delay_factor_XML->addText(&format_numbers($mpeg_stats{$f}{$pid}{'delay_factor'}));
		$media_bandwidth_XML->addText(&format_numbers($mpeg_stats{$f}{$pid}{'media_bandwidth'}));
		#dwell time
		$dwell_avg_XML->addText(&format_numbers( (10**3) * avg($pts_stats{$f}{$pid}{'dwell_sum'}, $pts_stats{$f}{$pid}{'num'})));
		$dwell_sdv_XML->addText(&format_numbers( (10**3) * sdv($pts_stats{$f}{$pid}{'num'}, 
								       $pts_stats{$f}{$pid}{'dwell_sum'}, 
								       $pts_stats{$f}{$pid}{'dwell_squared'}))),
		$dwell_min_XML->addText(&format_numbers( (10**3) * $pts_stats{$f}{$pid}{'min_dwell'}));
		$dwell_max_XML->addText(&format_numbers( (10**3) * $pts_stats{$f}{$pid}{'max_dwell'}));
	    }
	} 		
    }
}

sub init_file {
    undef $t0;
    my $f=shift;
    undef $tjoined; delete $tjoined{$f}; delete $setuptime{$f}; delete($joined{$file{$f}});
    delete $file{$f};
    @myflows=() if !$opt_sum;
    $flow_pkts{$f}=0;  # new flow on new file

    undef $pus;
    undef $psec;
    delete($pmtime{$f});
    delete($pseq_num{$f});
    delete($pus{$f});
}


sub seq_stat {
    my ($f, $seq_num, $mtime)=@_;

    my $seq_diff= $seq_num - $pseq_num{$f};
    unless ($opt_crude && $seq_diff == 1){ #
	$gap = $us - $pus{$f};		# packet time gap
	$ngap{$f}++;
	$sumgap{$f} +=  $gap;
	$ssgap{$f} += $gap**2;
	$maxgap{$f}=  $gap if $gap > $maxgap{$f};
	$mingap{$f}=  $gap if $gap < $mingap{$f};

	foreach $i (0 .. $#bins){
	    if( $gap < ($bins[$i]*1000)){
		$nbin[$i]++;
		last;
	    }
	}
	printf "Tx=%.6f gap=%d gap=%.1fms\n", $ptx{$f}, $seq_diff-1, $gap/1000, if $opt_log;
    }

    if ($seq_diff != 1) {
#	printf "seq %d,", $rtp->seq_num;

	if ($seq_diff == 0) { # Duplicated
	    $dup{$f} ++;
	} elsif ($seq_diff < 0) { # Out Of Order
	    $late{$f}++;
#		$lost{$f}--;
	} else {			# Lost                   
	    $lost{$f}+= $seq_diff - 1;
	    $nloss{$f}++;
	    $sumloss{$f} += $seq_diff;
	    $ssumloss{$f} += $seq_diff**2;
	    $maxloss{$f} = $seq_diff if  $seq_diff >  $maxloss{$f};
	}
    } elsif ( $mtime <= $pmtime{$f}){
	$ntimeerr{$f}++;
    } else { # the jitter can be measured
#  compute jitter relative to previous packet
	$mgap= ($mtime - $pmtime{$f} ); # media time gap in samples 8khz=us
	$jitter=abs($gap - $mgap);
#ok compute jitter relative to start
#ok	    $mgap= ($mtime - $first_mtime); # media time gap in us
#ok	    $jitter=abs($us - $mtime - $first_jitter);
	$njitter{$f}++;
	$sumjitter{$f} +=  $jitter;
	$ssjitter{$f} += $jitter**2;
	$maxjitter{$f}=  $jitter if $jitter > $maxjitter{$f};
	$minjitter{$f}=  $jitter if $jitter < $minjitter{$f};

	# rfc 3550 
	if (defined($est_jitter{$f})){
	    $est_jitter{$f} = $est_jitter{$f} + ( $jitter - $est_jitter{$f} )/16;
	} else { # inital value
	    $est_jitter{$f} = $jitter;
	}
    }

}

sub pkt_stats {
    my $f = shift; # file or stream name
    my $packet = shift;
    my $us = shift;
    my $dlen = shift;
    my $rtp = new Net::RTP::Packet();
    if (! exists($tstart{$f})){
		$tstart{$f} = $tc;
		$first_us{$f}=$prev1s_us{$f}=$prevt100ms_us{$f}=$us;
		if (! exists($setuptime{$f}) ){
		    if ( $pinterval){
			$setuptime{$f}=0;
		    } else {
			$setuptime{$f}=tv_interval ( $tjoined{$f}, $tstart{$f}) * 10**3;
		    }
		    printf "setup $f : %.3f\n",  $setuptime{$f} if $opt_debug;
		    #print "hei hei \n";
			alarm($opt_last) if $opt_last;
		}
    }
    $tend{$f} = $tc;
    $last_us{$f}=$us;
    #	next if $dlen < 20;  # typically small background noice packets added
    $npkt{$f}++;
    $sumbyte{$f}+=$dlen; $sum1s{$f}+=$dlen; $sum100ms{$f}+=$dlen;
    if (!exists $bw_stats{$f}){
    	$bw_stats{$f} = &share( {} );
    }
    $bw_stats{$f}{'sumbyte'} +=$dlen if $opt_tcp;
    $ssbyte{$f}+=$dlen**2;
    $maxbyte{$f}=  $dlen if $dlen > $maxbyte{$f};
    $minbyte{$f}=  $dlen if $dlen < $minbyte{$f};

    $sumps{$f}+=$dlen;		# sum per second

    if ($opt_dump){
	print DUMP $packet;
    }

    if ($opt_mpeg){
	mpeg_stats($f, $packet, $us);
    }

    if ($opt_rtp){
	if ( $rtp->decode($packet) ) { #assume RTP
#	    printf "RTP: %10s %5d %5d\n", $rtp->ssrc(), $rtp->timestamp(), $rtp->size();
#	    $dlen = $rtp->size();
	} else {
	    print "??? $f # $npkt{$f} $dlen B\n";
	    if ($opt_debug){
		my $n=0;
		foreach $w( unpack("C*", $packet)) {
		    printf "%0X",$w;
		    if ($n > 0){
			print " " if $n % 4 == 0;
			print "\n" if $n % 32 == 0;
		    }
		    $n++;
		}
		printf "\n";
	    }
	    next;
	}
	# Calculate next number in sequence
	$n_seq = $rtp->seq_num()+1;
	if ($n_seq > 65535) {
	    $n_seq=0;
	}
	$mtime{$f}=$rtp->timestamp() * &time_unit($rtp->payload_type);  # mediatime in us
	$seq_num{$f}=$rtp->seq_num;
    }

    if (defined($pus{$f})) {
	$gap = $us - $pus{$f};		# packet time gap
	$ngap{$f}++;
	$sumgap{$f} +=  $gap;
	$ssgap{$f} += $gap**2;
	$maxgap{$f}=  $gap if $gap > $maxgap{$f};
	$mingap{$f}=  $gap if $gap < $mingap{$f};

	if ($opt_rtp){
	    &seq_stat($f, $seq_num{$f}, $mtime{$f});
	}
	if ($adapt == 1 ) { # adaption field coming
	    my ($length, $aflags, $rest2)=unpack "C1C1C*", $rest;
	    my ($dif, $raif, $espif, $pcrf, $opcrf, $splicef, $tpdf, $afextf)=split(//, $aflags); 
	    if ($pcrf == 1){
		;
	    }
	    printf "%5d %6d %5d %5d %5d %5d %5d\n",$rtp->seq_num,$us,$rtp->timestamp(), $gap,  $mgap, $jitter, $first_jitter if $opt_debug;
	    
	} elsif ($opt_crude){
	    &seq_stat($f, $seq_num{$f}, $mtime{$f});

	} 
	&burst($f);
    }
    if ($opt_period){
		$interval=int($us/10**6 / $opt_period);
		if ($interval > $pinterval){
	    	&mpeg_debug() if $opt_debug;
	    	&display_stats() if !$endstream;
	    	&init_stats($f);
	    	$pinterval=$interval;
	    	$pinterval{$f}=$interval;
	    	$endstream = $opt_nperiod && $interval >= $opt_nperiod;
		}
    }
    $pus=$us;
    $psec=$sec;
    $pmtime{$f}=$mtime{$f} if $opt_rtp || $opt_crude;
    $pseq_num{$f}= $seq_num{$f} if $opt_rtp ||  $opt_crude;
    $pus{$f}=$us;
} # of pkt_stats

sub do_math{
    my $f = shift;
    my $span = shift;
    my $pts_stats = (\%pts_stats);
    if ($opt_mpeg){
	$pcr_stats{$f}{$TS}{'pcr_avg_jitter'} = (10**3)*avg($pcr_stats{$f}{$TS}{'pcr_jitter_sum'}, $pcr_stats{$f}{$TS}{'num'});
	$pcr_stats{$f}{$TS}{'pcr_sdv_jitter'} = (10**3)*sdv($pcr_stats{$f}{$TS}{'num'}, $pcr_stats{$f}{$TS}{'pcr_jitter_sum'},$pcr_stats{$f}{$TS}{'pcr_jitter_square'});
	for my $k1 ( sort keys %$pts_stats ) {
	    for my $pid ( keys %{$pts_stats->{ $k1 }} ) {
		#if ( grep { $_ eq $pts_stats->{ $f }{ $pid }{ 'stream_id_type'} || $_ eq 'all'} @filter) {
		    $pts_stats{$k1}{$pid}{'dwell_avg'} = (10**3) * avg($pts_stats{$k1}{$pid}{'dwell_sum'}, $pts_stats{$k1}{$pid}{'num'});
		    $pts_stats{$k1}{$pid}{'dwell_sdv'} = (10**3) * sdv($pts_stats{$k1}{$pid}{'num'}, $pts_stats{$k1}{$pid}{'dwell_sum'},  $pts_stats{$k1}{$pid}{'dwell_squared'});
		    $mpeg_stats{$k1}{$pid}{'media_bandwidth'} = ((($mpeg_stats{$k1}{$pid}{'num'} * 188)*8)/$span);
		    $mpeg_stats{$k1}{$pid}{'avg_packets_1s'} = avg($mpeg_stats{$k1}{$pid}{'num'},$span);
		    $mpeg_stats{$k1}{$pid}{'media_loss_rate'} = ($mpeg_stats{$k1}{$pid}{'lost_packets'}/$span);
		    $mpeg_stats{$k1}{$pid}{'media_bandwidth'} = 1 if $mpeg_stats{$k1}{$pid}{'media_bandwidth'}==0; #Zero division protection.
		    $mpeg_stats{$k1}{$pid}{'delay_factor'} = ((($mpeg_stats{$k1}{$pid}{'avg_packets_1s'}* $pts_stats{$k1}{$pid}{'dwell_avg'}*(10**-3))*188)/$mpeg_stats{$k1}{$pid}{'media_bandwidth'})*(10**2) if($opt_new || $opt_xml);
		#}
	    }
	}
    }
    if($opt_tcp){
	$tcp_packet_stats{$f}{'span'} =  $span;
	$tcp_packet_stats{$f}{'bandwidth_avg'} = (($tcp_packet_stats{$f}{'num_bytes'}*8)/$span);
	$tcp_packet_stats{$f}{'jitter_avg'} = avg($tcp_packet_stats{$f}{'jitter_sum'},$tcp_packet_stats{$f}{'num_packets'}); 
	$tcp_packet_stats{$f}{'jitter_sdv'} = sdv($tcp_packet_stats{$f}{'num_packets'}, $tcp_packet_stats{$f}{'jitter_sum'}, $tcp_packet_stats{$f}{'jitter_square'});
	$tcp_packet_stats{$f}{'gap_avg'} = (10**3)*avg($tcp_packet_stats{$f}{'gap_sum'},$tcp_packet_stats{$f}{'num_packets'});
	$tcp_packet_stats{$f}{'gap_sdv'} = (10**3)*sdv($tcp_packet_stats{$f}{'num_packets'}, $tcp_packet_stats{$f}{'gap_sum'}, $tcp_packet_stats{$f}{'gap_square'});
    }
}

sub burst {
    my $f=shift;
    my $span=$last_us{$f}-$first_us{$f};
    my $per1s=int(($span/10**6)+.05); # adds .005 because the timing seems to be a bit off.
    my $per100ms=int($span/10**5);
    if (!$uninterrupted){
    	$per1s = $span/10**6; #$span < 1, if interrupted.
    }
    if ($per1s > $per1s{$f}){ # period expired
		my $per=($last_us{$f}-$prev_1s{$f})/10**6;
		if ($per>0 || $uninterrupted != 1){
			my $bps = $sum1s{$f} * 8 / $per;
		    $maxbps{$f} = $bps if $bps > $maxbps{$f};
		    $per1s{$f} = $per1s;
		    $prev_1s{$f} = $last_us{$f};
		    $sum1s{$f}=0;
		    if ($opt_tcp) {
				$bw_stats{$f}{'maxbps'} =  $bps if $bps > $bw_stats{$f}{'maxbps'};
				$bw_stats{$f}{'per1s'}= $per1s;
				$bw_stats{$f}{'per1s'}= $last_us{$f};
		    }
		}
    }
    if ( $per100ms > $per100ms{$f} ){ # period expired
		my $per=($last_us{$f}-$prev_100ms{$f})/10**6;
		if ($per>0){
		    my $bps = $sum100ms{$f} * 8 / $per;
		    $max100ms{$f} =  $bps if $bps > $max100ms{$f};
		    $n100ms{$f}++;
		    $ss100bps{$f}+= $bps**2;
		    $akk100ms{$f}+=$bps;
		    $per100ms{$f} =  $per100ms;
		    $prev_100ms{$f} = $last_us{$f};
		    $sum100ms{$f}=0;
		    if($opt_tcp){
				$bw_stats{$f}{'max100ms'} = $bps if $bps > $bw_stats{$f}{'max100ms'} ;
				$bw_stats{$f}{'n100ms'}++;
				$bw_stats{$f}{'ss100bps'} +=$bps**2;
				$bw_stats{$f}{'akk100ms'} +=$bps;
				$bw_stats{$f}{'per100ms'} = $per100ms;
		    }
		}
    }
}

sub jitter_stats {
    my $pts_stats = shift;
    my $span = shift;
    my $counter = 0;
    my $max_colums = (length(@filter)+1);
    for my $k1 ( sort keys %$pts_stats ) {
    	for my $k2 ( keys %{$pts_stats->{ $k1 }} ) {
	    if ( grep { $_ eq $pts_stats->{ $k1 }{ $k2 }{ 'stream_id_type'} || $_ eq 'all'} @filter) {
		$counter++;
		$jitter_stats{$k2}{'dwell_avg'} = &lesbar( (10**3) * avg($pts_stats{$k1}{$k2}{'dwell_sum'}, $pts_stats{$k1}{$k2}{'num'}));
		$jitter_stats{$k2}{'dwell_min'} = &lesbar( (10**3) * $pts_stats{$k1}{$k2}{'min_dwell'});
		$jitter_stats{$k2}{'dwell_max'} = &lesbar( (10**3) * $pts_stats{$k1}{$k2}{'max_dwell'});
		$jitter_stats{$k2}{'dwell_sdv'} = &lesbar((10**3) * sdv($pts_stats{$k1}{$k2}{'num'}, $pts_stats{$k1}{$k2}{'dwell_sum'},  $pts_stats{$k1}{$k2}{'dwell_squared'}));
		$jitter_stats{$k2}{'type'} = $pts_stats->{ $k1 }{ $k2 }{ 'stream_id_type'};
		$jitter_stats{$k2}{'media_loss_rate'} =  ($mpeg_stats{$k1}{$k2}{'lost_packets'}/$span);
		$jitter_stats{$k2}{'DF'} =  $mpeg_stats{$k1}{$k2}{'delay_factor'};
		last if $counter >= $max_colums;
	    }
      	}
    }		    
    return \%jitter_stats;
}

sub get_date_time{
    my $flow = shift;
#    $flow = $f if ! $flow; # current flow if not given
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($tstart{$flow}->[0]);
    my $time=sprintf "%02d:%02d:%02d", $hour, $min, $sec;
    if ($format eq "full"){
	$time.=sprintf ".%06d", $tstart{$flow}->[1];
    } else {
	my $time=sprintf "%02d:%02d:%02d", $hour, $min, $sec;
    }
    my $date=sprintf "%4d-%02d-%02d", $year+1900, $mon+1, $mday;
    return ($date,$time);
}


#--------------------------------------------------------------------------------
sub display_stats{
    @myflows=@streams if ($#myflows < 0); # no response
    foreach $f (sort @myflows) {
	#my ($ip,$port) = prepare_ip($f) if $opt_tcp;
	#$f =  $ip.":".$port if $opt_tcp;
		$period_num++;
		if ($opt_xml){
		    if($opt_tcp || $opt_rtmp){
			&xml_dump_rtmp_tcp($f);
		    }
		    else {
			&xml_dump($f);
		    }	
		}
		else {
			&print_out($f) if !$opt_q || $opt_rtmp;
		}
    }
}

sub print_out {
		return 0 if $opt_rtmp;
		my $f = $_[0]; # *Not* shift. This gets called from a signal handler.
		my $source=$f;
		my ($pts_stats) = (\%pts_stats);
		$source=$source{$f} if  ! $opt_v && $source{$f} ne "";
		$source=$opt_id if $opt_id;
		my $jitter_stat= $opt_rtp || $opt_crude;
		my ($date,$time)  = &get_date_time();
		my $span = &tv_interval($tstart{$f}, $tend{$f}); # second
		#&do_math($f,$span);
		&burst($f); # in case a second is interrupted
	
		my $media="file";
   	    $media = "host:port" if $opt_net;
			my $id=$f;
			my $source=$f; 
			next if $npkt{$f} < $opt_flow_min;
			my $n=$npkt{$f}; $n=1 if $npkt{$f} < 1; # divide by zero protection
			my $njitter = $njitter{$f}; $njitter =1 if $njitter{$f} < 1;
			$source=$source{$f} if  ! $opt_v && $source{$f} ne "" && !$file_flag;
			$source=$opt_id if $opt_id;
			my $jitter_stat= $opt_rtp || $opt_crude;
			my ($date,$time)  = &get_date_time($f);
			my $span = &tv_interval($tstart{$f}, $tend{$f}); # second
			&do_math($f,$span);
			my $jitter_stats = jitter_stats($pts_stats,$span);
			&burst($f); # in case a second is interrupted
		#	printf "dus %d min %.2f\n", $us-$pus, $max100ms{$f};
		#	$max100ms{$f}=-1  if  $max100ms{$f} > 2**61;
		#	$maxbps{$f}=-1  if ! $maxbps{$f} > 0;
			
			#moduler:
			my @dwell_head;
			my @dwell_head2;
			my @dwell_values;
			my @pcr;
			my $head = "        pcr_jitter(ms)	   ";
			my $head2 = "    avg   sdv   min   max";
			my $head3 = "    avg   sdv   min   max";
			my $values = ""; 
	
			push(@pcr,$head);
			push(@pcr,$head2);
			
			if ($opt_mpeg){
				for my $k1 (sort keys %$jitter_stats){
					push(@dwell_head," dwell_time(ms)[$jitter_stats{$k1}{'type'}]    ");
					push(@dwell_head2, $head3);
					$values = "$jitter_stats{$k1}{'dwell_avg'} $jitter_stats{$k1}{'dwell_sdv'} $jitter_stats{$k1}{'dwell_min'} $jitter_stats{$k1}{'dwell_max'}";
					push(@dwell_values,$vales);
				}
			}
			my @output = (@dwell_head);
			my $mos;
#ok			print "$npkt{$f} \n";
				if ($jitter_stat){
				    $mos=&mos_r($codec, $rtt,  avg( $sumgap{$f}, $ngap{$f}) / 1000,
							avg($sumjitter{$f}, $njitter)/1000, 
							100*$nloss{$f}/$n );
				}
			if ($opt_v) {
			    #Prints header
			    if ($date ne $pdate) {
				if (! $opt_nohead){
				    print "\nDate $date            packet  size(byte)           packet distance(ms) ";
				    print "       time    sequence         loss               packet jitter(ms)        		  " if $jitter_stat;
				    #print  "      flu-    pcr_jitter(ms)             dwell_time(ms)[$filter]   " if $opt_mpeg;
				    print @pcr[0] if $opt_mpeg;
				   # print  "      flu-    pcr_jitter(ms)	 " if $opt_mpeg;
				    print @dwell_head;
				    my $first=1;
				    if ($opt_new){
				    	for my $k1 (sort keys %$jitter_stats){
				    		print "    	" if $first==2;
				    		print "[$jitter_stats{$k1}{'type'}]";
				    		print "    	" if $first==1;
				    		$first++;
				    	} 
				    }
				    #if ($opt_mpeg){   
				#		for my $k1 (sort keys %$jitter_stats){
				#			print "dwell_time(ms)[$jitter_stats{$k1}{'type'}] 	 ";
				#		}
				    #} 	
				    #print  "      flu-    pcr_jitter(ms) 		PCR_gap (ms) " if $opt_mpeg;
				    print "      	   " if $opt_new;
				    print "  load(bps)            source\n";                      
				    printf "%-8s %6s %6s     %4s%4s %4s %4s %4s   %6s %4s %4s %4s %4s",
				    "time","span", "setup",
				    "numb ", "avg", "sdv", "min", "max",
				    "numb", "avg", "sdv", "min", "max";
				    printf "  %5s %5s %5s %5s %5s %5s %5s",
				    "stamp", "dup", "late", "lost", "gaps", "avg", "sdv", if $jitter_stat;
				    printf " %6s %4s %4s %4s %4s %4s %5s ", "numb", "avg", "sdv", "min", "max", "rfc", "MOS" if $jitter_stat;
		
				    #printf " %5s ", "ency", "" if $opt_mpeg;
				    print @pcr[1] if $opt_mpeg;
				    #printf " %4s %5s %5s %5s ", "avg", "sdv", "min", "max" if $opt_mpeg;
				    #printf " %4s %5s %5s %5s", "avg", "sdv", "min", "max" if $opt_mpeg;
				   	#foreach my $head2 (@dwell_head2){
				   	#	print $head2;
				   	#110}
				    foreach (keys %$jitter_stats){
				    	print "   avg   sdv   min   max ";
				    }
				    $first=1;
				    if ($opt_new){
				   		foreach (keys %$jitter_stats){
				   			print "    " if $first=>1;
				    		print "num  lost  MRL  DF";
				    		$first++;
				    	}
				    }
				    #print "    " if @opt_new;
				    #printf " %4s %5s %5s %5s", "avg", "sdv", "min", "max" if $opt_mpeg;
				    printf " %5s %5s %5s %5s  	 %-15s\n",
				    "avg",  "1s", "100ms", "sdv", $media;
					}
			    }
			
			    if ( $npkt{$f} >= 0 && $ngap{$f}>= 0) {
				if (! $jitter_stat) { $minjitter{$f}=0; $maxjitter{$f}=0;}
				if ($ngap{$f} < 1 ){
				    $mingap{$f}=0; $maxgap{$f}=0;
				    printf "Resetting maxbps\n" if $opt_debug;
				    $max100ms{$f}=0; $maxbps{$f}=0;
				}
				
				printf "%8s %6s %6s %8s", 
				$time, &lesbars($span,3), &lesbars($setuptime{$f},3), &lesbar($npkt{$f},8);
				my $n=$npkt{$f}; $n=1 if $npkt{$f} <1; # divide by zero protection
				printf " %4s %4s %4d %4d  ", &lesbar($sumbyte{$f}/$n,4), 
				&lesbar(sdv($npkt{$f}, $sumbyte{$f}, $ssbyte{$f})),	
				$minbyte{$f}, $maxbyte{$f};
		
				printf " %6s %4s %4s %4s %4s ", 
				&lesbar($ngap{$f},6), &lesbars( avg( $sumgap{$f}, $ngap{$f}) / 1000 ),
				&lesbars(sdv($ngap{$f}, $sumgap{$f},$ssgap{$f})/1000),
				&lesbars($mingap{$f}/1000), &lesbars($maxgap{$f}/1000);
		
		#				printf (" %5s %.1e",
		#					&lesbar($mpeg_stats{$f}{'num'},3),
		#					(&largest_deviation(1/16, $mpeg_stats{$f}{'num'}, \@cc),6)) if $opt_mpeg;
				#printf (" %4s",
				#&lesbar(compare_cc_dists(\%dist1,\%dist2)), #fluency
				#	"") if $opt_mpeg;
				
				#printf " %5s %5s %5s %5s %5s %5s",
	
				printf " %5s %5s %5s %5s", 
				&lesbar( (10**3) * avg($pcr_stats{$f}{$pcr_pid{$f}}{'pcr_jitter_sum'}, $pcr_stats{$f}{$pcr_pid{$f}}{'num'})),
				&lesbar( (10**3) * sdv($pcr_stats{$f}{$pcr_pid{$f}}{'num'}, 
						       $pcr_stats{$f}{$pcr_pid{$f}}{'pcr_jitter_sum'}, 
						       $pcr_stats{$f}{$pcr_pid{$f}}{'pcr_jitter_square'})),
				&lesbar( (10**3) * $pcr_stats{$f}{$pcr_pid{$f}}{'min_jit'}),
				&lesbar( (10**3) * $pcr_stats{$f}{$pcr_pid{$f}}{'max_jit'}),
				    if $opt_mpeg;
				if ($opt_mpeg){   
					for my $k1 (sort keys %$jitter_stats){
						printf " %5s %5s %5s %5s  ",
						$jitter_stats{$k1}{'dwell_avg'}, 
						$jitter_stats{$k1}{'dwell_sdv'},
						$jitter_stats{$k1}{'dwell_min'},
						$jitter_stats{$k1}{'dwell_max'},
					} 
				}
				if ($opt_mpeg && $opt_new){  
					for my $k1 (sort keys %$jitter_stats){
						printf "%7d %3d %4.1f %4.1f ",
						$mpeg_stats{$f}{$k1}{'num'},
						$mpeg_stats{$f}{$k1}{'lost_packets'},
						$jitter_stats{$k1}{'media_loss_rate'},
						$mpeg_stats{$f}{$k1}{'delay_factor'} 
						;
					}
				}
			  	
				#printf " %5s %5s %5s %5s ", 
				#lesbar( (10**3) * avg($pts_stats{$f}{$TS}{'dwell_sum'}, $pts_stats{$f}{$TS}{'num'})),
				#lesbar( (10**3) * sdv($pts_stats{$f}{$TS}{'num'}, 
				#			      $pts_stats{$f}{$TS}{'dwell_sum'}, 
				#		      $pts_stats{$f}{$TS}{'dwell_squared'})),
				#lesbar( (10**3) * $pts_stats{$f}{$TS}{'min_dwell'}),
				#lesbar( (10**3) * $pts_stats{$f}{$TS}{'max_dwell'}),
				#   if $opt_mpeg;
				
		
				printf " %5s %5s %5s %5s %5s %5s %5s ",
				&lesbar($ntimeerr{$f}), &lesbar($dup{$f}),  &lesbar($late{$f}),  &lesbar($lost{$f}), 
				&lesbar($nloss{$f}),  &lesbar( avg( $sumloss{$f}, $nloss{$f}) ),  
				&lesbar( sdv($lost{$f}, $sumloss{$f},  $ssumloss{$f}))
				    if $jitter_stat;
		
				printf " %6s %4.1f %4.1f %4.1f %4.1f %4.1f %4.1f ",
				&lesbar($njitter{$f}),
				avg($sumjitter{$f}, $njitter{$f})/1000,
				sdv($njitter{$f}, $sumjitter{$f}, $ssjitter{$f})/1000,
				$minjitter{$f}/1000, $maxjitter{$f}/1000,
					 $est_jitter{$f}/1000, $mos
				    if $jitter_stat;
				
				printf " %5s %5s %5s %5s  %s \n",
				&lesbar( avg( $sumbyte{$f}*8, $span ) ), 
				&lesbar($maxbps{$f}), 
				&lesbar($max100ms{$f}), 
				&lesbar(sdv($n100ms{$f},
					    $akk100ms{$f}, 
					    $ss100bps{$f})),
				$source
				
			    } else { # not reached
				printf "%-8s %6s %6s %8s %4s %4d %4d %4d %6d %4s %4s %4s %4s %5d %5d %5d %5d %s\n", $time, 0, 0, &lesbar($npkt{$f},4), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, $source if $f ne "" && $npkt{$f}>=0;
			    }
		
			} else {  #not -v
			    if ($date ne $pdate) {
				if (! $opt_nohead){
				    if($opt_mpeg){
					print "\nDate $date       packet      ";
				    } else {
					print "\nDate $date       packet      size(byte)   ";
				    }
				    if ($jitter_stat){
					print "jitter(ms)                " ;
				    } elsif ($opt_mpeg) {
					#print "pcrjit(ms)   pcrgap(ms)    " ;
					print "pcrjit(ms)  dwell (ms)    " ; #oldmode
					#print "pcrjit(ms) @dwell_head	 ";
					
				    } else  {
					print "gap(ms)                   " ;
				    }
				    print "thrust(bps)       source	\n";                      
		
				    if($opt_mpeg) {
					printf "%-8s %8s %4s %4s %4s ", 
		                        #"time","numb", "dup", "late", "lost", "numb", "dscnt";
					"time","numb", "dup", "late", "lost";
				    } else {
					printf "%-8s %8s %4s %4s %4s %4s %4s", 
					"time","numb", "dup", "late", "lost", "avg", "sdv";
				    }	
		
				    if($opt_mpeg) {
					printf " %5s %5s %5s %5s",
					"avg", "sdv", "avg", "sdv"; #pcr and 
		
				    } 
				    elsif($opt_rtp){
				    printf " %5s %5s %5s %5s %5s",
					"avg", "sdv", "min", "max", "MOS"; # if $jitter_stat;
				    	
				    }
				    else {
					printf " %5s %5s %5s %5s",
					"avg", "sdv", "min", "max"; # if $jitter_stat;
				    }	
		
				    printf "    %4s %5s %5s %s\n",
				    "avg", "1s", "100ms", $media;
				}
		
			    }
		
			    if ( $npkt{$f}>= 0 && $ngap{$f}>= 0) { 
				my @jitterstat=(0,0,0,0);
				my $n=$npkt{$f}; $n=1 if $npkt{$f} <1; # divide by zero protection
		
				if ($jitter_stat){
				    @jitterstat= (&lesbars($sumjitter{$f}/$njitter/1000),
						  &lesbars(sdv($njitter{$f}, $sumjitter{$f}, $ssjitter{$f})/1000),
						  &lesbars($minjitter{$f}/1000), 
						  &lesbars($maxjitter{$f}/1000));
				} elsif ($opt_mpeg) {
					my $dwell_avg = 0;
					my $dwell_sdv = 0;
					for my $k1 (sort keys %$jitter_stats){
						 $dwell_avg = $jitter_stats{$k1}{'dwell_avg'};
						 $dwell_sdv = $jitter_stats{$k1}{'dwell_sdv'};
					} 
				    
				    @jitterstat = (
		
						   &lesbar( (10**3) * avg($pcr_stats{$f}{$TS}{'pcr_jitter_sum'}, $pcr_stats{$f}{$TS}{'num'})),
						   &lesbar( (10**3) * sdv($pcr_stats{$f}{$TS}{'num'}, 
									  $pcr_stats{$f}{$TS}{'pcr_jitter_sum'}, 
									  $pcr_stats{$f}{$TS}{'pcr_jitter_square'})),
									  $dwell_avg,
									  $dwell_sdv,
						   #&lesbar( (10**3) * avg($pts_stats{$f}{$TS}{'dwell_sum'}, $pts_stats{$f}{$TS}{'num'})),
						   #&lesbar( (10**3) * sdv($pts_stats{$f}{$TS}{'num'}, 
							#		  $pts_stats{$f}{$TS}{'dwell_sum'}, 
							#		  $pts_stats{$f}{$TS}{'dwell_squared'})),
						   );	
		
				} else {
					
				    @jitterstat=( &lesbars( avg($sumgap{$f}, $ngap{$f}) / 1000),
						  &lesbars(sdv($ngap{$f}, $sumgap{$f},$ssgap{$f})/1000),
						  &lesbars($mingap{$f}/1000),  &lesbars($maxgap{$f}/1000) );
				}
		
				printf "%8s %8d %4d %4d %4s",
				$time, $npkt{$f}, $dup{$f}+$ntimeerr{$f}, $late{$f}, &lesbar($lost{$f},4);
		
				if($opt_mpeg){
		
				} else {
				    printf " %4d %4.1f", $sumbyte{$f}/$n, sdv($n, $sumbyte{$f}, $ssbyte{$f});
				}
				printf   " %5s %4.1f  	%4.1f %5s ",@jitterstat;
				if ($opt_rtp){
					printf " %4.1f", $mos;
				}
				printf "   %5s %5s %5s  %s ", 
				&lesbar( avg($sumbyte{$f}*8, $span)), 
				&lesbar($maxbps{$f}), 
				&lesbar($max100ms{$f}),
				$source;
				print "\n";
				
			
				#printf "in-print: \n\n%f\n\n", $maxbps{$f};
			    } else {
				printf "%-8s %8s %68s     %s\n",$time, lesbar($npkt{$f},4),"", $source if $f ne "" && $npkt{$f}>0;
			    }
		
			}
	$opt_nohead=1;
	$pdate=$date;
	$flow_pkts{$f}=0;
}
sub display_bins{
    print "\n\nBins    ";
    foreach $bin (@bins){
	printf "%5d ", $bin;
    }
    print "\nGaps    ";
    foreach $i (0 .. $#bins){
	printf "%5d ", $nbin[$i];
    }
    print "\n";
}

sub avg {  
    my ($sum, $n)=@_;
    return 0 if $n <= 0;
    return $sum/$n;
}
sub sdv {
    my ($n, $sum, $sumsq)=@_;
    if ($n > 1) {
	return sqrt( abs($sumsq/$n -  ($sum/$n)**2));
    } else {
	return  0;
    }
}

sub lesbar{
    my ($n, $figs)=@_;
    $figs = 3 if ! $figs;
    return sprintf ("%.1f", $n) if $format ne "pretty";

    @dekade=("", "K", "M", "G", "T", "P");
    for ($d=0; $d<=$#dekade; $d++){
	$dekade=10**(3*$d);
	my $nd=$n / $dekade;

	if ( $nd < 10**$figs){ # 3 siffer OK
	    if ( $nd > 100 || ($n < 10000 && $n == int($n))){
		return (sprintf "%d", $nd) . $dekade[$d];
	    } else { 
		return sprintf "%.1f%s", $nd, $dekade[$d];
	    }
	}
    }
    return sprintf "%E", $n;

}

sub lesbars {
    my ($n, $figs)=@_;
    return &lesbar($n, $figs) if $format ne "pretty";
    if ($n > 1000){
	my $num = &lesbar($n /1000, $figs) . "s";
	$num=~s/ //; 
	return $num;
    } else {
	return  &lesbar($n, $figs);
    }

}

# compute timeunits in mediatime from rfc 3551
# limited to static payload-types
sub time_unit{
    my $payload_type=shift;
    $sample_freq{0}=8000;
    $sample_freq{3}=8000;
    $sample_freq{4}=8000;
    $sample_freq{5}=8000;
    $sample_freq{6}=16000;
    $sample_freq{7}=8000;
    $sample_freq{8}=8000;
    $sample_freq{9}=8000;
    $sample_freq{10}=44100;
    $sample_freq{11}=44100;
    $sample_freq{12}=8000;
    $sample_freq{13}=8000;
    $sample_freq{14}=90000;
    $sample_freq{15}=8000;
    $sample_freq{16}=11025;
    $sample_freq{17}=22050;
    $sample_freq{18}=8000;
    $sample_freq{726}=8000;
    $sample_freq{726}=8000;
    $sample_freq{726}=8000;
    $sample_freq{726}=8000;
    $sample_freq{729}=8000;
    $sample_freq{729}=8000;
    $sample_freq{25}=90000;
    $sample_freq{26}=90000;
    $sample_freq{28}=90000;
    $sample_freq{31}=90000;
    $sample_freq{32}=90000;
    $sample_freq{33}=90000;
    $sample_freq{34}=90000;

    return 10**6/($sample_freq{$payload_type}||8000);
}

sub list_flows {
    my $n=0;
    printf "\n\n%4s   %-50s %10s    %s\n", "No", "    Flow key", "Packets", "File" if  ! $opt_nohead;;
    foreach $f ( @flows){
	printf "%4d   %-50s %10d    %s\n", $n+++1, $f, $flow_pkts{$f}, $file{$f};
    }    
    $opt_nohead=1;
}
sub search {
	my $string = shift;
	my @ret;
	 my $regex = "47";
	  while ($string =~ /$regex/g) {
        push @ret,($-[0]);
    }
    return @ret
}
sub find_sync_byte_old{
	my $data  = shift;
	my @hex_string  =  unpack("H2864", $data);
	my @offset_array = &search(@hex_string);
#s	print "@offset_array \n";
	my $length = @offset_array;
	my @offset;
	for (my $i = 0; $i < $length;$i++){
		my $temp = $offset_array[$i+1] - (376+$offset_array[$i]);
		my $sync_byte = $offset_array[$i]+376;
		if($offset_array[$i]==120){
		#	print "HALLO \n";
		} 
		for my $pos (@offset_array){
			if($pos == $sync_byte){
				push(@offset,$offset_array[$i]);
			}			
		}
	}
	return @offset;
}


sub find_sync_byte {
	my $f = shift;
	my $data  = shift;
	my $hex_size = do {use bytes; length($data)*2};
	my @hex_string  =  unpack("H2864", $data);
	my $hex_scalar  =  unpack("H2864", $data);
	my @offset_array = &search(@hex_string);
	@g_array = qw();
	my $length = @offset_array;
	for (my $i = 0; $i < $length;$i++){
		#my $temp = $offset_array[$i]+376;
		for (my $j = $i+1; $j < $length; $j++){
			#print "  $offset_array[$j]  ...........\n";
			#print "$offset_array[$i], \n";
			if ($offset_array[$j] == $offset_array[$i]+376){
			#	print "  $offset_array[$j]  ...........\n";
			push(@g_array, $offset_array[$i]);
				}
		}
		
	}
	my $g_size =  @g_array;
	
	if ($g_array[$g_size-1]+376  <= $hex_size){
		if($g_array[$g_size-1]+752 > $hex_size){
			my $byte_pos = ($g_array[$g_size-1]+376);
			$offset_bytes{$f} = substr($data,($byte_pos/2),($hex_size/2));
			#print "size $hex_size \n";
			#print "offsetYO ", $offset_bytes{$f}, "\n";
		}
		else {
			push(@g_array,$g_array[$g_size-1]+376);
		}
	}	
	return @g_array;
}	
sub mpeg_stats
{
    my ($flow_id, $packet, $us) = @_;
	my $l;
	my $n = 7;
	#Assume the packet-size is 188 bytes. Might be 204 if error-correcting codes 
	#are in use.
	my @ret;
	my $offset = 0;
	if ($opt_tcp){
	    @ret = &find_sync_byte($flow_id,$packet);
	    $n = @ret;
	   #print "@ret \n";
	}
#One UDP-packet contains $n number of MPEG-TS packets, check every one:
     if (exists $offset_bytes{$flow_id}){
     		#my $offset_size = do {use bytes; length($offset_bytes{$flow_id})};
     		my $rest = substr($packet,0,$ret[0]/2);
     		#print "new off ", $ret[0]/2, "\n";
     		my $scrambled_packet .= $offset_bytes{$flow_id};
     		$scrambled_packet .= $rest;
		my $offset_size = do {use bytes; length($scrambled_packet)};
		#print "offset " , $offset_size, "\n";
		$tspack = mpegtspacket->new ($scrambled_packet);
		$mpeg_stats{$flow_id}{'num'} += 1;
		$TS = $tspack->PID();
		$mpeg_stats{$flow_id}{$TS}{'num'} += 1;
		#print "scramb \n";
		#cc_update_stats($flow_id, $tspack, $us);
		#cc_update_stats($flow_id, $tspack, $us);
		#$lost_counter++; 
		delete $offset_bytes{$flow_id};
		#print "$lost_counter \n";
     }
 
    for(my $j = 0; $j < $n; ++$j) {
    my $var = $j*188;
    #print " j $j ....N $n \n";
	#print $mpeg_stats{$flow_id}{'num'},   "\n";
	if ($opt_tcp) {
		if (@ret == 0){
			#print "next $j \n" if $debug;
			#$lost_counter++;
			next;}
		$var =  ($ret[$j]/2);
		if ($var !~ /^\d+$/) {
			#print "@ret \n";
			#$lost_counter++; 
			#print "$var $j THIS \n" if $debug;
			next;}
	}
	$tspack = mpegtspacket->new (substr($packet,$var,188));
	$mpeg_stats{$flow_id}{'num'} += 1;
	$TS = $tspack->PID();
	$mpeg_stats{$flow_id}{$TS}{'num'} += 1;

	#init values
	if ($mpeg_stats{$flow_id}{$TS}{'num'} == 1){ 
		$mpeg_stats{$f}{$TS}{'lost_packets'} = 0;
		$mpeg_stats{$f}{$TS}{'duplicated_packets'} = 0;
		$mpeg_stats{$f}{$TS}{'late_packets'} = 0;
	}
	
#Update continuity counters
	cc_update_stats($flow_id, $tspack, $us);


	if ($tspack->is_valid() != 1) { 
		
		next; }

#PCR calcs.
	if ($tspack->pcr_flag() == 1) {
	    pcr_update_stats($flow_id, $tspack);
	    ++$pcr_count;
	}


#Dwell calculations
	if ($tspack->payload_unit_start() == 1) {
	    dwell_update_stats($flow_id, $tspack);
	
	} else {
	    next;
	}

    }

#Set the time for the last UDP packet
    $mpeg_stats{$flow_id}{'last_udp_time'} = time();
}

#This function uses globals:
#%pcr_stats()
sub pcr_update_stats
{
    my ($f, $tspack) = @_;
    if (!exists $pcr_pid{$f}){
    	$pcr_pid{$f} = $TS;
    }
    
# We might have wrapped around, which creates weird results.
# this is just a work-around... - reset pcr_checks if large values

	if (($pcr_stats{$f}{$TS}{'last_pcr'} > $tspack->pcr_s())  and
		($pcr_stats{$f}{$TS}{'last_pcr'} > 47000) and
		($tspack->pcr_s() < 10000)) {
	    $pcr_stats{$f}{$TS}{'initialized'} = 0;
	}
#
    if ($pcr_stats{$f}{$TS}{'initialized'}) { 
	$d_pcr = (($tspack->pcr_s() - $pcr_stats{$f}{$TS}{'last_pcr'}) + $PCR_MAX) % $PCR_MAX;
    # Time between our local clocks
	$d_t = time() - $pcr_stats{$f}{$TS}{'real_last_time'};
	$pcr_stats{$f}{$TS}{'real_last_time'} = time();
#		++$pcr_stats{$f}{$TS}{'num'};
        if($d_pcr < 0){ # resequenced
	    $late{$f}++;
	}
	#print "TS value ",$TS, ".... PCR ", $tspack->pcr_s(), "\n";

#time gap in miliseconds between recived PCR values. 
	if ($d_t > $pcr_stats{$f}{$TS}{'max_pcr_gap'}) {
	    $pcr_stats{$f}{$TS}{'max_pcr_gap'} = ($d_t); #in MS
	} 
	if ($d_t < $pcr_stats{$f}{$TS}{'min_pcr_gap'}) {
	    $pcr_stats{$f}{$TS}{'min_pcr_gap'} = ($d_t); #in MS
	}
	my $sample = abs($d_pcr - $d_t);
	my $k = $pcr_stats{$f}{$TS}{'num'};
	$pcr_stats{$f}{$TS}{'pcr_jitter_sum'} += $sample;
	$pcr_stats{$f}{$TS}{'pcr_jitter_square'} += ($sample**2);
	++$pcr_stats{$f}{$TS}{'num'};
#Max/Min-checks for PCR jitter

	if ($sample > $pcr_stats{$f}{$TS}{'max_jit'}) {
	    $pcr_stats{$f}{$TS}{'max_jit'} = $sample;
	} 
	if ($sample < $pcr_stats{$f}{$TS}{'min_jit'}) {
	    $pcr_stats{$f}{$TS}{'min_jit'} = $sample;
	}

#This calculates the PCR arrival difference mean and std 	
#$sample = $d_pcr;
	$tm = $pcr_stats{$f}{$TS}{'running_dpcr_mean'};
	$ts = $pcr_stats{$f}{$TS}{'running_dpcr_std'};
	$pcr_stats{$f}{$TS}{'running_dpcr_mean'} = $tm + (($sample - $tm)/$k);
	$tm2 = $pcr_stats{$f}{$TS}{'running_dpcr_mean'};	
	$pcr_stats{$f}{$TS}{'running_dpcr_std'} = $ts + (($sample - $tm)*($sample - $tm2));
	
#Max/Min-checks for delta-PCR
	if ($sample > $pcr_stats{$f}{$TS}{'max_dpcr'}) {
	    $pcr_stats{$f}{$TS}{'max_dpcr'} = $sample;
	} 
	if ($sample < $pcr_stats{$f}{$TS}{'min_jit'}) {
	}

	$pcr_stats{$f}{$TS}{'last_pcr'} = $tspack->pcr_s();
	$pcr_stats{$f}{$TS}{'last_pcrb'} = $tspack->pcrb_s();

	$packets_between_pcr = 0;

#Got a new PCR-value, so synch the clocks
    } else {
#This is the first time we see a PCR, intialize hash.
#Time between this pcr and the last measured.
#$d_pcr = (($tspack->pcr() - $pcr_stats{$f}{$TS}{'last_pcr'}))/(27*10**6);
#Time between our local clocks
#= time() - $pcr_stats{$f}{$TS}{'real_last_time'};


	$pcr_stats{$f}{$TS}{'running_jit_mean'} = 0; #($d_pcr - $d_t);
	$pcr_stats{$f}{$TS}{'running_jit_std'} = 0;
	$pcr_stats{$f}{$TS}{'running_dpcr_mean'} = 0; #first time
	$pcr_stats{$f}{$TS}{'running_dpcr_std'} = 0;
	$pcr_stats{$f}{$TS}{'real_last_time'} = time();
	$pcr_stats{$f}{$TS}{'last_pcr'} = $tspack->pcr_s();
	$pcr_stats{$f}{$TS}{'last_pcrb'} = $tspack->pcrb_s();
	$pcr_stats{$f}{$TS}{'pcr_jitter_sum'} = 0;
	$pcr_stats{$f}{$TS}{'num'} = 0;
	$pcr_stats{$f}{$TS}{'max_jit'} = 0;
	$pcr_stats{$f}{$TS}{'min_jit'} = (2**32)-1;
	$pcr_stats{$f}{$TS}{'max_dpcr'} = 0;
	$pcr_stats{$f}{$TS}{'min_dpcr'} = (2**32)-1;
	$pcr_stats{$f}{$TS}{'initialized'} = true;
	$pcr_stats{$f}{$TS}{'missing_pcrs'} = 0;
	$pcr_stats{$f}{$TS}{'min_pcr_gap'} = (2**32)-1;
	$pcr_stats{$f}{$TS}{'max_pcr_gap'} = 0;
    }

}

#uses :
#last_ccs
#
sub cc_update_stats
{
    my ($f, $tspack, $us) = @_;
    my $secs = $us*10**(-6);
    my $pid = $tspack->PID();
    my $prior = $last_ccs{$pid};
    my $cc = $tspack->continuity_counter();
    check_continuity($f,$pid, 
		     $cc,
		     $tspack->{'discontinuity'}, 	
		     $tspack->payload_unit_start() );

#printf("%d %d\n", $tspack->PID(), $tspack->continuity_counter());

#update continuity overview
    $last_ccs{$pid} = $tspack->continuity_counter();
  
#update the per-counter continuity.
    $cc[$tspack->continuity_counter()]++;

#distribution updates
    if(!$_period || ($secs % $opt_period < ($opt_period/2))) {
	$dist1{$pid} += 1;
    } elsif($secs % $opt_period <= ($opt_period)) {
	$dist2{$pid} += 1;
    } 
}

sub compare_cc_dists
{
    my ($a, $b) = @_;
#	print Dumper(%$a); 
#	print "\n";
#	print Dumper(%$b); 
    my $metric = 0;
    foreach my $pid (keys %$a) {	
		my $diff = $a->{$pid} - $b->{$pid};
		my $sum = $a->{$pid} + $b->{$pid};
	#	print "sum: $sum diff: $diff\n";
	#       $metric += $diff / $sum;
		$metric = exp($diff/1000);
    }

    if ($metric){
	return 10/$metric;
    } else {
	warn "Metric invalid $metric" if $opt_debug;
	return -1;
    }
}


sub dwell_update_stats
{	
    my ($f, $tspack) = @_;
    my $pespack = mpegpespacket->new ($tspack->payload());
    $pts_stats{$f}{$TS}{'stream_id'} = $pespack->{'stream_id'};
    $pts_stats{$f}{$TS}{'stream_id_type'} = $pespack->_stream_id_type();
    #Appends new transport streams pids to table.
    next if ($pespack->is_valid != 1); #stream must be audio or video to get correct dwelltime.
#pts_stuff
    if($pespack->{'PTS_flag'} == 1) {
    
	++$pts_stats{$f}{$TS}{'num'};
	
	if($pts_stats{$f}{$TS}{'initialized'} == 1) {
#check if frame is late,# not used -PMM
	   if($pespack->pts_s() != 0 and $pespack->pts_s() < $pcr_stats{$f}{$pcr_pid{$f}}{'last_pcr'}) {
		$pts_stats{$f}{$TS}{'late_frames'}++;
	   }
	   $pts_stats{$f}{$TS}{'last_pts'} = $pespack->pts_s();
# 4 - Dwell-time calculations
	    if($pcr_stats{$f}{$pcr_pid{$f}}{'last_pcr'} > 0 and $pespack->pts_s() > 0)  {   #we want to compare against valid PCR
	    
	   # print "PCR PID  ", $pcr_pid{$f} , "\n";
	   # print "PTS STATS ", $pts_stats{$f}{$TS}{'dwell_sum'}, "\n";
	    $d_t = time() - $pcr_stats{$f}{$pcr_pid{$f}}{'real_last_time'};
		my $dwell = ((abs(($pcr_stats{$f}{$pcr_pid{$f}}{'last_pcr'}+$d_t) - $pespack->pts_s())) + $PTS_MAX) % $PTS_MAX;
		$pts_stats{$f}{$TS}{'dwell_sum'} += $dwell;
		$pts_stats{$f}{$TS}{'dwell_squared'} += $dwell**2;
		$pts_stats{$f}{$TS}{'last_dwell'} = $dwell;

#min/max calcoolatins
		if ($dwell > $pts_stats{$f}{$TS}{'max_dwell'}) {
		    $pts_stats{$f}{$TS}{'max_dwell'} = $dwell;
		} 
		if ($dwell < $pts_stats{$f}{$TS}{'min_dwell'}) {
		    $pts_stats{$f}{$TS}{'min_dwell'} = $dwell;
		}
	    }
	} elsif ($pespack->pts_s() > 0 ) {
	    my $dwell = ((abs($pcr_stats{$f}{$pcr_pid{$f}}{'last_pcr'} - $pespack->pts_s())) + $PTS_MAX) % $PTS_MAX;
	    $presentation_time = $pespack->pts_s();
	    $pts_stats{$f}{$TS}{'mean_dwell'} = 0;
	    $pts_stats{$f}{$TS}{'dwell_squared'} = 0;
	    $pts_stats{$f}{$TS}{'std_dwell'} = $dwell;
	    $pts_stats{$f}{$TS}{'max_dwell'} = 0;
	   	$pts_stats{$f}{$TS}{'min_dwell'} = (2**32)-1;
	    $pts_stats{$f}{$TS}{'last_dwell'} = $dwell;
	    $pts_stats{$f}{$TS}{'late_frames'} = 0;
	    $pts_stats{$f}{$TS}{'num'} = 0;
	    $pts_stats{$f}{$TS}{'initialized'} = 1;
		}
    }

}


sub init_dwell{
	my ($f,$TS)  = @_;
	my $dwell = ((abs($pcr_stats{$f}{$pcr_pid{$f}}{'last_pcr'} - $pespack->pts_s())) + $PTS_MAX) % $PTS_MAX;
	$presentation_time = $pespack->pts_s();
    $pts_stats{$f}{$TS}{'mean_dwell'} = 0;
    $pts_stats{$f}{$TS}{'dwell_squared'} = 0;
    $pts_stats{$f}{$TS}{'std_dwell'} = $dwell;
    $pts_stats{$f}{$TS}{'max_dwell'} = 0;
   	$pts_stats{$f}{$TS}{'min_dwell'} = (2**32)-1;
    $pts_stats{$f}{$TS}{'last_dwell'} = $dwell;
    $pts_stats{$f}{$TS}{'late_frames'} = 0;
    $pts_stats{$f}{$TS}{'num'} = 0;
    $pts_stats{$f}{$TS}{'initialized'} = 1;
}

sub check_continuity
{
    my ($f,$pid, $cc, $discont, $payload) = @_;
    if (!exists $mpeg_stats{$f}{$pid}{'lost_packets'}){
    	$mpeg_stats{$f}{$pid}{'lost_packets'} = 0;
    }
  
    if (not exists $last_ccs{$pid}) {
		return;
    }	
    if ($last_ccs{$pid} == $cc and $payload == 0) {
		return;	
    }
    if (($last_ccs{$pid} + 1)%16 == $cc) {
		return;
    }
    if ($last_ccs{$pid} == $cc) {
		return;
    }
    $discontinuities++;
   	$mpeg_stats{$f}{$pid}{'lost_packets'}++;
}




sub mpeg_debug
{
    print "Debug: ";
    print Dumper(%pcr_stats);
    print Dumper(%pts_stats);
    print Dumper(%mpeg_stats);
    print Dumper(@cc);
}

sub largest_deviation
{
    my ($expected, $num, $values) = @_;
#	print "\n\nhnnng: $num\n\n";
    my $max = 100000000;
    foreach $id (@$values) {
	my $val = abs(($id/$num) - $expected) if $num != 0;
#		printf("\nValue:%s, Expected: %s\n", $id/$num, $expected);
	if( $val < $max) {
	    $max = $val;
	}
    }
    return $max;
}

#########################################################################
#
# compute the MOS value from R in the E-model
# Gurvinder Singh, 2010-05-07


sub init_mos{
     $Nc = -70;	# sum of all circuit noise powers, referred to the 0 dBr point
     $Ps = 35;	# room noise Ps at the sender side
     $Pr = 35;	# room noise Ps at the receiver side
     $slr = 8;	# Sender Loudness Rating
     $rlr = 2;	# Receiver Loudness Rating
     $Ds = 3;	# D-Value of Telephone, Sender Side
     $Dr = 3;	# D-Value of Telephone, Receiver Side
     $lstr = 18;	# Listener Sidetone Rating
     $stmr = 15;	# Sender Sidetone Masking Rating
     $Nfor = -64;	# Noise Floor at the Receiver Side
     $telr = 65;	# Talker Echo Loudness Rating
     $wepl = 110;	# Weighted Echo Path Loss
}

# Subtorutine to convert the natural log value to log base 10
    sub log10 {
	my $n = shift;
	return log($n)/log(10);
    }
    
# Subroutine to calculate the time related variable values to be used
# in calculating the impairements caused by the delay (Id)
    sub calc_timevar
    {
	my ($l_pl, $l_jitter, $l_rtt) = @_;
	my $Ta = 2 * $l_pl + $l_jitter + $l_rtt;
	my $T = $Ta;
	my $Tr = 2 * $Ta;
	
	return $Ta, $T, $Tr;
    }

# Subroutine to calculate the Mean Opinion Score (MOS) value from the given 
# R value obtained from E-model (ITU-T Rec. G.107). An estimate of the result
# of a subjective test. Higher values indicate better quality
sub calc_mos
{
    my ($r) = @_;
    my $mos;
    
    if ($r < 0) {
	$mos = 1;
    } elsif ($r > 100) {
	$mos = 4.5;
    } else {
	$mos = 1 + 0.035*$r + $r * ($r - 60) * (100 - $r) * 7 * (10 ** (-6));
	if ($mos < 1) {
	    $mos = 1;
	}
    }

    printf "Mos value is: %.02f \n",$mos if $opt_debug;
    return $mos;
}

# Subroutine to calculate the Ro, which represents in principle the basic
# signal-to-noise ratio, including noise sources such as circuit noise and
# room noise. T
sub calc_Ro
{
    my $Nfo = $Nfor + $rlr;
    my $olr = $slr + $rlr;
    my $Pre =35 + 10 * log10(1 + (10 ** (-0.8)));
    my $Nor = $rlr - 121 + $Pre + 0.008 * (($Pre - 35)**2);
    my $Nos = $Ps - $slr - $Ds - 100 + 0.004 *(($Ps - $olr - $Ds - 14)**2);
    my $No = 10 * log10((10**($Nc/10)) + (10**($Nos/10)) +
			(10**($Nor/10)) + (10**($Nfo/10)));

    my $Ro = 15 - (1.5 * ($slr + $No));
    print "Ro is: $Ro No is: $No\n"  if $opt_debug;
    return $Ro, $No;
}

# Subroutine to calculate Is, where Is is a combination of all impairments
# which occur more or less simultaneously with the voice signal.
sub calc_Is
{
    my ($qdu, $Ro, $No, $T) = @_;

    ######### Calculate the Iolr ##########
    my $olr = $slr + $rlr;
    my $xolr = $olr + 0.2*(64 + $No - $rlr);
    my $Iolr = 20 * (((1 + ($xolr/8)**8)**(1/8)) - ($xolr/8));

    ######### Calculate the Ist ##########
    my $stmro = -10 * log10((10**(-$stmr/10))+(exp(-$T/10) *
					       (10**(-$telr/10))));

    my $Ist = (12 * ((1+((($stmro - 13)/6)**8))**(1/8))) -
	(28 * ((1+((($stmro + 1)/19.4)**35))**(1/35))) -
	(13 * ((1+((($stmro - 3)/33)**13))**(1/13))) + 29;

    ######### Calculate the Iq ##########
    my $Q = 37;
    $Q -= 15 * log10($qdu) if $qdu > 0;
    my $G = 1.07 + (0.258 * $Q) + (0.0602 * ($Q**2));
    my $Z = 1.53 - $G/40;	# 46/30 = 1.53
    my $Y = (($Ro - 100)/15) + 5.47 - $G/9;	# 46/8.4 = 5.47
    my $Iq = 15 * log10(1 + 10**$Y + 10 **$Z);

    ######### Calculate the Is ##########
    my $Is = $Iolr + $Ist + $Iq;
    print "Is is: $Is, Iolr is: $Iolr, Ist is: $Ist, Iq is : $Iq\n" if $opt_debug;

    return $Is, $Ist;
}

# Subroutine to calculate the Id, which represents the impairments caused
# by the delay
sub calc_Id
{
    my ($Ro, $No, $Ist, $Ta, $T, $Tr) = @_;

    ######### Calculate the Idte ##########
    my $Idte;
    my $terv;
    if ($T < 1) {
	$Idte = 0;
    } else {
	$terv = $telr - 40 * log10((1 + ($T/10))/(1 + ($T/150))) +
	    6 * exp(-0.3 * ($T**2));
	if ($stmr < 9) {
	    $terv += $Ist/2;
	}
	
	my $Re = 80 + 2.5 * ($terv - 14);
	my $Roe = -1.5 * ($No - $rlr);
	$Idte = (($Roe - $Re)/2 +
		 sqrt(((($Ro - $Re)**2)/4) + 100) - 1)*
		 (1 - exp(-$T));
    }

    if ($stmr > 20) {
	my $Idtes = sqrt($Idte**2 + $Ist**2);
	$Idte = $Idtes;
    }

    ######### Calculate the Idle ##########
    my $Rle = 10.5 * ($wepl + 7) * (($Tr + 1)**(-1/4));
    my $Idle = ($Ro - $Rle)/2 + sqrt(((($Ro - $Rle)**2)/4) + 169);

    ######### Calculate the Idd ##########
    my $Idd;
    if ($Ta > 100) {
	my $X = log10($Ta/100) / log10(2);
	$Idd = 25 * (((1+ ($X**6))**(1/6)) - (3 * ((1+ (($X/3)**6))**(1/6))) + 2);
    } else {
	$Idd = 0;
    }
    
    ######### Calculate the Id ##########
    my $Id = $Idte + $Idle +$Idd;
    print"Id is: $Id Idte is: $Idte Idle is: $Idle Idd is: $Idd\n"  if $opt_debug;

    return $Id;
}

# Subroutine to calculate the impairement value depending
# upon the codec used in the communication
# Ref: Short- and Long-Term Packet Loss Behavior: Towards 
# Speech Quality Prediction for Arbitrary Loss Distributions
# by Alexander Raake
sub calc_codecvar
{
    my $l_codec = shift;
    
    # Initialize the impairment values
    my $Ie = 0;	# A scalar number allocated to a specific type of
    # impairment (codec), indicating the anticipated
    # incremental value of impairment (decrease of the
    # transmission rating factor R) resulting from the
    # type of impairment (codec). 

    my $Bpl = 0;	# Bpl is the robustness of a codec to random packet
    # loss. 

    my $Pc = 0.3;	# conditional packet loss probability in case of
    # consecutive packets loss

    if  ($l_codec eq "G.711") {
	$Ie = 0;
	$Bpl = 25.1;
    } elsif ($l_codec eq "G.723.1") {
	$Ie = 15;
	$Bpl = 16.1;
    } elsif ($l_codec eq "G.729A") {
	$Ie = 11;
	$Bpl = 19;
    } elsif ($l_codec eq "iLBC") {
	$Ie = 11;
	$Bpl = 32;
    }

    return $Ie, $Bpl, $Pc;
}

# Subroutine to calculate the Ie-eff, which represents impairments caused
# by low bit rate codecs and  impairment due to packet-losses of random
# distribution
sub calc_Ieff
{
    my ($Ie, $Bpl, $Pc, $Ppl) = @_;
    my $pl = $Ppl / 100;
    my $burstR = (1 - $pl) / (1 - $Pc);
    my $Ieff = $Ie + (95 - $Ie)*($Ppl/(($Ppl/$burstR) + $Bpl));
    
    print"Ieff is: $Ieff\n" if $opt_debug;
    return $Ieff;
}

# Subroutine to calculate the R value using E-model (ITU-T Rec. G.107)
# R is the result of the E-model, estimating users' satisfaction for
# transmission planning purposes.
sub calc_r
{
    my ($Ro, $Is, $Id, $Ieff, $A) = @_;
    my $r = $Ro - $Is - $Id - $Ieff + $A;
    printf"R is: %.02f \n",$r if $opt_debug;
    return $r;
}

# Analogue/Digital and Digital/Analogue conversions involve a distortion of
# the signal, perceived as a quantization noise. qdu is defined as the
# quantization noise resulting from a complete A/D encoding and D/A decoding
# following the 8 bit A-law (or mu-law), according to ITU-T Recommendation
# G.711. Note, that the qdu concept is no longer used for coders other than
# G.711. If an impairment factor Ie is used for a piece of equipment, then the
# qdu value for that same piece of equipment must not be used.
# my $qdu = 1;		# Number of Quantization Distortion Units



# Advantage factor, depends upon the communication device used
# This factor enables the planner to take into account the fact that users
# may accept some decrease in quality for access advantage, e.g. mobility
# or connections into hard-to-reach regions
# my $A = 0;	# For fixed wired phones it is 0 (Ref. ITU-T G.107)

sub mos_r{
# Time values related to the monitored connection
#    my $codec = $opt_codec || 'G.711';
#    my $rtt = $opt_rtt || 10;		# ms round trip time of the connection
#    my $pl;		# RTP packet length in ms
#    my $jitter;	        # Jitter value for this connection
#    my $Ppl;		# Percentage of the packet loss
    my ($codec, $rtt, $pl, $jitter, $Ppl)=@_;

    &init_mos;

    my $qdu = 0;		# Number of Quantization Distortion Units
    my $A = 0;	# For fixed wired phones it is 0 (Ref. ITU-T G.107)

    my @time_ret = calc_timevar($pl, $jitter, $rtt);
    my @codec_ret = calc_codecvar($codec);
    my @ro_ret = calc_Ro;
    my @Is_ret = calc_Is($qdu, $ro_ret[0], $ro_ret[1],$time_ret[1]);
    my $Id_ret = calc_Id($ro_ret[0], $ro_ret[1], $Is_ret[1], $time_ret[0],
			 $time_ret[1], $time_ret[2]);
    my $Ieff_ret = calc_Ieff($codec_ret[0], $codec_ret[1], $codec_ret[2], $Ppl);
    my $r_ret = calc_r($ro_ret[0], $Is_ret[0], $Id_ret, $Ieff_ret, $A);
    my $mos_ret = calc_mos($r_ret);

    return($mos_ret);
} # of mos_r


################################################################################

package mpegtspacket;

################
#
# Net::MPEG-TS::Packet: MPEG-TS packet object (perl only)
#
# UNINETT 2009 (www.uninett.no)
# Dabbler in code: Odd Rune S. Lykkebø <lykkebo@pvv.ntnu.no>
#
# References:
# [1] - ISO 13818-1

use strict;
use Carp; #The mother hen is watchful.
use Bit::Vector;

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


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

    my $self = {
	valid => 1,
	size => undef,
	sync_byte => 0x47,
	transport_error => 0,
	transport_priority => 0,
	payload_unit_start => 0,
	PID => undef,
	transport_scrambling => 0,
	adaption_field_control => undef,
	continuity_counter => 0,

#Adaption fields
	adaption_field_length => 0,
# flags
	discontinuity => 0,
	random_access => 0,
	elementary_stream_priority => 0,
	PCR_flag => 0,   #ok
	OPCR_flag => 0, #ok
	splicing_point => 0,
	transport_private_data => 0,
	adaption_field_extension_flag => 0,

# optional adaption fields existence based on flags
	program_clock_reference_base => 0, #ok
	program_clock_reference_extension => 0, 
	PCR => 0,
	original_program_clock_reference_base => 0, #ok
	original_program_clock_reference_extension => 0, 
	splice_countdown => 0,
	transport_private_data_length => 0,
	private_data => 0,
	adaption_field_extension_length => 0,
# mu?
	ltw_flag => 0,
	piecewise_rate_flag => 0,
	seamless_splice_flag => 0,
	ltw_valid_flag => 0,
	ltw_offset => 0,
	piecewise_rate => 0,
	splice_type => 0,
	DTS => 0,

	payload => undef,

    };
    bless ($self, $class);

    my $res = undef;
    if (defined ($packet)) {
	$self->decode ($packet);
    } else {
#Ok, want to create a packet -- that's... easy ?
#so, stuff stuff inside and hope for merry xmas.
#mpeg-ts doesn't really have any complicated fields,
#should be okeydokey
    }

    return $self;
}

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

sub adaption_field_control
{
    my $self = shift;
    my ($afc) = @_;

    if (defined $afc and (
($afc != 1) or
($afc != 2) or 
($afc != 3))) {
	carp "Bad value to adaption field control!";
    }
$self->{'adaption_field_control'} =	$afc if (defined $afc);

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

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

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

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

sub compare_cc_dists
{
    my (%a, %b) = @_;
    my $metric = 0;
    foreach my $pid (keys %a) {
	my $diff = $a{$pid} - $b{$pid};
	my $sum = $a{$pid} + $b{$pid};
	$metric += $diff * $sum;
	$metric /= 10;
    }
}


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


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

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

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

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

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


sub pcrb
{
    my $self = shift;
    my ($pcrb) = @_;
    if (defined $pcrb) {
	$self->{'program_clock_reference_base'} = $pcrb;
	$self->{'PCR_flag'} = 1;
    }
    return $self->{'program_clock_reference_base'};
}

sub pcrb_s
{
    my $self = shift;
    return $self->{'program_clock_reference_base'}/(90000);
}

sub pcr
{
    my $self = shift;
    return $self->{'program_clock_reference_base'}*300 + $self->{'program_clock_reference_extension'};
}

sub pcr_s
{
    my $self = shift;
    my $base = Math::BigFloat->new($self->{'program_clock_reference_base'})->bdiv(90000);
    return $base;
}


#TODO: Reed-Solomon fault tolerance stuff.
sub payload
{
    my $self = shift;
    my ($payload) = @_;
    if (defined $payload) {
	$self->{'payload'} = $payload;
    }
    return $self->{'payload'};
}

sub pp_header 
{
    my $self = shift;
    print "== MPEG TS HEADER ==\n";
    printf ("PID: %d\n".
	    "Transport priority: %d\n".
	    "Payload unit start: %d\n".
	    "Transport error: %d\n".
	    "Scrambling: %s\n".
	    "Adaption field: %s\n".
	    "Continuation counter: %s\n",
	    $self->{'PID'},
	    $self->{'transport_priority'},
	    $self->{'payload_unit_start'},
	    $self->{'transport_error'},
	    $self->{'transport_scrambling'},
	    $self->{'adaption_field_control'},
	    $self->{'continuity_counter'});
    print ":: == MPEG TS HEADER END == ::\n";
}

#pretty-print the adaption field
sub pp_adaption_field
{
    my $self = shift;
    if ($self->{'adaption_field_length'} < 1) {
	carp "No adaption field to print.\n";
	return;
    }
    print "== Adaption field ==\n";
    printf ("Length(bytes): %d", $self->{'adaption_field_length'});
    printf ("Discontinuity: %d".
	    "Random Access: %d".
	    "Priority: %d".
	    "PCR-flag: %d ".
	    "OPCR-flag: %d ".
	    "Splicing point: %d ".
	    "Transport Private data: %d".
	    "Adaption field extension: %d ",
	    $self->{'discontinuity'},
	    $self->{'random_access'}, 
	    $self->{'elementary_stream_priority'}, 
	    $self->{'PCR_flag'}, 
	    $self->{'OPCR_flag'}, 
	    $self->{'splicing_point_flag'}, 
	    $self->{'transport_private_data'},
	    $self->{'adaption_field_extension'});

    print ("= Adaption field extensions =\n");
    if ($self->{'PCR_flag'} == 1) {
	printf ("PCR: %d", 
		$self->{'program_clock_reference_base'});
    }

    if ($self->{'OPCR_flag'} == 1) {
	printf ("OPCR: 0x%x", 
		$self->{'original_program_clock_reference_base'});
    }
    print "\n";

}

#The eternal mess of 7 demons. 
sub decode 
{
    my $self = shift;
    my ($packet) = @_;

#Extract the length of the packet. Should be 188 or 204 bytes.
    $self->{'size'} = length ($packet);
    carp "Bad packet size ($self->{'size'})\n" if ($self->{'size'} > (204*8));

#Decode the standard 4-byte header (ISO/IEC 13818-1)
    my ($sync, 
	$flags_pid, 
	$scradaptcont, 
	$adapt_and_payload) = unpack ("C n C a*", $packet);
	my $omg = unpack("H200",$packet);
    if ($sync != 0x47) {
	carp "Wops: bad sync byte ($sync) hex: $omg !\n" if $debug;
	$self->{'valid'} = 0;
    }

    $self->{'sync_byte'} = $sync;
#	$flags_pid = hex $flags_pid;
    $self->{'transport_error'} = ($flags_pid & 0x8000) >> 15;
    $self->{'payload_unit_start'} = ($flags_pid >> 14) & 0x0001;
    $self->{'transport_priority'} = ($flags_pid & 0x2000) >> 13;
    $self->{'PID'} = ($flags_pid & 0x1FFF);
    $self->{'transport_scrambling'} = ($scradaptcont & 0xC0) >> 6;
    $self->{'adaption_field_control'} = ($scradaptcont & 0x30) >> 4;
    $self->{'continuity_counter'} = ($scradaptcont & 0x0F);

    if ($self->{'adaption_field_control'} == 2 or
	($self->{'adaption_field_control'} == 3)) {
#decode adaption field
	$self->_decode_adaption_field ($adapt_and_payload);
    }

#only payload
    if ($self->{'adaption_field_control'} == 1){
	$self->{'payload'} = $adapt_and_payload;
	my ($pes_prefix, $stream_id, $pes_length, $baz) = unpack "H6 H2 H4 a*", $adapt_and_payload;
	
    }	
#Adaptation field followed by payload
    elsif ($self->{'adaption_field_control'} == 4) {
	my ($adapt_length) = unpack ("C", $adapt_and_payload);
	my $l = $adapt_length + 1;
	$self->{'payload'} = unpack ("x$l a*", $adapt_and_payload);
	print "payload \n";
    }
}

sub _decode_adaption_field
{
    my $self = shift;
    my ($bin) = @_;
    
#Check for presence of adaption field
    my ($length, 
	$flags, 
	$adaption_opts_and_payload) = unpack ("C B8 a*", $bin);

#Sanity checks, concerning the length of the adaption fields, page 21 in [1]
    my $adaptc = $self->{'adaption_field_control'};
    if ($adaptc == 2 and $length != 183) {
	carp "Adaption field of illegal size ($adaptc) ($length)\n";
	return;
    }

    if ($adaptc == 3 and $length > 182) { 
	carp "Adaption field of illegal size ($adaptc) ($length)\n";
	return;
    }

    return if ($length < 1);

    $self->{'adaption_field_length'} = $length;

    ($self->{'discontinuity'} ,
     $self->{'random_access'} ,
     $self->{'elementary_stream_priority'} ,
     $self->{'PCR_flag'} ,
     $self->{'OPCR_flag'} ,
     $self->{'splicing_point_flag'} ,
     $self->{'transport_private_data'} ,
     $self->{'adaption_field_extension'} ) = split(//, $flags);

#Based on flags, we fill in the adaption field structures.
    my $field_position = 0;
    my ($foo, $bar); #because perl doesn't allow me to skip bits
    if ($self->{'PCR_flag'} == 1) {
	
	my ($bs) = unpack ("B48", $adaption_opts_and_payload);
	my $base = substr ($bs, 0, 33);
	my $extension = substr ($bs, 39, 9);
	
	$self->{'program_clock_reference_base'} = Math::BigInt->new("0b".$base);
	$self->{'program_clock_reference_extension'} = oct ("0b".$extension);
	$field_position += 6;
    }


    if ($self->{'OPCR_flag'} == 1) {
	($self->{'original_program_clock_reference_base'}, $foo,
	 $self->{'original_program_clock_rererence_extension'},
	 $bar) = unpack ("x$field_position B33 B6 B9 a*", 
			 $adaption_opts_and_payload);
	$field_position += 6;	
    }

    return $self;

}

sub bin2dec 
{
    return unpack("N", pack("B32", substr("0" x 32 . shift, -32)));
}


return (1);

package mpegpespacket;

################
#
# Net::MPEG-TS::PES-Packet: 
#
# UNINETT 2009 (www.uninett.no)
# Dabbler in code: Odd Rune S. Lykkebø <lykkebo@pvv.ntnu.no>
#
# References:
# [1] - ISO 13818-1


use strict;
use Carp;
use Bit::Vector;

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


use constant PES_PREFIX => 0x000001;

use constant PROGRAM_STREAM_MAP => 0xBC;
use constant PRIVATE_STREAM_1 => 0xBD;
use constant PADDING_STREAM => 0xBE;
use constant PRIVATE_STREAM_2 => 0xBF;
use constant ECM_STREAM => 0xF0;
use constant EMM_STREAM => 0xF1;
use constant DSMCC_STREAM => 0xF2;
use constant ITU_222_A => 0xF4; 
use constant ITU_222_B => 0xF5; 
use constant ITU_222_C => 0xF6; 
use constant ITU_222_D => 0xF7; 
use constant ITU_222_E => 0xF8; 
use constant ANCILLARY_STREAM => 0xF9;
use constant ISO_14496_PACKETIZED_STREAM => 0xFA;
use constant ISO_13396_FLEXMUX_STREAM => 0xFB;
use constant PROGRAM_STREAM_DIRECTORY => 0xFF;

# From [1]:
#      1011 1100       1 program_stream_map
#      1011 1101       2 private_stream_1
#      1011 1110         padding_stream
#      1011 1111       3 private_stream_2
#      110x xxxx         ISO/IEC 13818-3 or ISO/IEC 11172-3 or ISO/IEC 13818-7 or ISO/IEC
#                        14496-3 audio stream number x xxxx
#      1110 xxxx         ITU-T Rec. H.262 | ISO/IEC 13818-2 or ISO/IEC 11172-2 or ISO/IEC
#                        14496-2 video stream number xxxx
#      1111 0000       3 ECM_stream
#      1111 0001       3 EMM_stream
#      1111 0010       5 ITU-T Rec. H.222.0 | ISO/IEC 13818-1 Annex A or ISO/IEC 13818-
#                        6_DSMCC_stream
#      1111 0011       2 ISO/IEC_13522_stream
#      1111 0100       6 ITU-T Rec. H.222.1 type A
#      1111 0101       6 ITU-T Rec. H.222.1 type B
#      1111 0110       6 ITU-T Rec. H.222.1 type C
#      1111 0111       6 ITU-T Rec. H.222.1 type D
#      1111 1000       6 ITU-T Rec. H.222.1 type E
#      1111 1001       7 ancillary_stream
#      1111 1010         ISO/IEC14496-1_SL-packetized_stream
#      1111 1011         ISO/IEC14496-1_FlexMux_stream
#1111 1100 ... 1111 1110   reserved data stream
#      1111 1111       4 program_stream_directory

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

    my $self = {
	valid => 0,
	packet_start_code_prefix => undef,
	stream_id => undef,
	packet_length => 0,
	scrambling_control => 0,
	priority => 0,
	data_alignment_indicator => 0,
	copyright => 0,
	original_or_copy => 1,
	PTS_flag => 0,
	DTS_flag => 0,
	ESCR_flag => 0,
	ES_rate_flag => 0,
	DSM_trick_mode_flag => 0,
	additional_copy_info_flag => 0,
	CRC_flag => 0,
	extension_flag => 0,
	header_data_length => 0,
	marker_bit => 0,
	PTS => undef,
	DTS => undef,
	ESCR_base => undef,
	ESCR_extension => undef,
	ES_rate => undef,
	trick_mode_control => undef,
	slow_motion => undef,
	freeze_frame => undef,
	fast_reverse => undef,
	slow_reverse => undef,
	field_id => undef,
	rep_cntrl => undef,
	additional_copy_info => undef,
	previous_PES_packet_CRC => undef,
	PES_private_data_flag => 0,
	pack_header_field_flag => 0,
	program_packet_sequence_counter_flag => 0,
	P_STD_buffer_flag => 0,
	PES_extension_flag_2 => 0,
	PES_private_data => undef,
	pack_field_length => undef,
	program_packet_sequence_counter => undef,
	MPEG1_MPEG2_identifier => undef,
	original_stuff_length => undef,
	P_STD_buffer_scale => undef,
	P_STD_buffer_size => undef,
	PES_extension_field_length => undef,
	stuffing_byte => undef,
	PES_packet_data_byte => undef,
	padding_byte => 0xFF,   #wtf

	payload => undef, 
    }; 
    bless ($self, $class);

    if (defined ($packet)) {
	$self->decode ($packet);
    } else {
#TODO: Encode packet :-) 
    }

    return $self;
}

sub ppme
{
    my $self = shift;
    if ($self->{'packet_start_code_prefix'} != PES_PREFIX) {
	print "NOT PES PACKET HEADER:";
	print $self->{'packet_start_code_prefix'};
	print "\n";
	return;
    }
    printf(	"- PES -\n".
		"Prefix: 0x%x\n".
		"Length: %s\n".
		"Stream-id: 0x%x (%s)\n".
		"Optional sections:\n".
		"pes_scrambling_control: %s\n".
		"pes_priority: %s\n".
		"data_aligmnent_indicator: %s\n".
		"copyright: %s\n".
		"original_or_copy: %s\n".
		"pts_flag: %s\n".
		"dts_flag: %s\n".
		"escr_flag: %s\n".
		"es_rate_flag: %s\n".
		"dsm_trick_mode_flag: %s\n".
		"additional_copy_info_flag: %s\n".
		"crc_flag: %s\n".
		"extension_flag: %s\n".
		"header_data_length: %s\n".
		"ES-rate (bytes/s): %d\n".
		"PTS: %f\n".
		"- END PES -\n",
		$self->{'packet_start_code_prefix'}, 
		$self->{'packet_length'},
		$self->{'stream_id'},
		$self->_stream_id_type ($self->{'stream_id'}),
		$self->{'PES_scrambling_control'} ,
		$self->{'PES_priority'} ,
		$self->{'data_aligmnent_indicator'} ,
		$self->{'copyright'} ,
		$self->{'original_or_copy'} ,
		$self->{'PTS_flag'} ,
		$self->{'DTS_flag'} ,
		$self->{'ESCR_flag'} ,
		$self->{'ES_rate_flag'} ,
		$self->{'DSM_trick_mode_flag'} ,
		$self->{'additional_copy_info_flag'} ,
		$self->{'CRC_flag'} ,
		$self->{'extension_flag'} ,
		$self->{'header_data_length'},
		50 * $self->{'ES_rate'},
		(300*$self->{'PTS'})/(27*(10**6))
		);
}


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


sub payload
{
    my $self = shift;
    my ($payload) = @_;
    if (defined $payload) {
	$self->{'payload'} = $payload;
    }
    return $self->{'payload'};
}
#checks if stream is vidoe or audio
sub dwell_valid
{
    my $self = shift;
    if ($self->{'stream_id'} >= 0xe0 and $self->{'stream_id'} <= 0xef or $self->{'stream_id'} >= 0xc0 and $self->{'stream_id'} <= 0xcf){
	    return 1;
    }
    else {
	    return 0;
    }
}

sub _stream_id_type
{
    my $self = shift;

    if ($self->{'stream_id'} >= 0xe0 and $self->{'stream_id'} <= 0xef) {
	return "video";
    } elsif ($self->{'stream_id'} >= 0xc0 and $self->{'stream_id'} <= 0xcf) {
	return "audio";
    } elsif ($self->{'stream_id'} == PRIVATE_STREAM_1) { return "Private_stream_1"; }	
    elsif ($self->{'stream_id'} == PROGRAM_STREAM_MAP) { return "program_stream_map"; }	
    else {
	return "unk";
    }
}

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

    my $flags_data = undef;	
    my $prefix = undef;
    ($prefix,		
     $self->{'stream_id'},
     $self->{'packet_length'},
     $flags_data) = unpack ("H6 C H4 a*", $packet);

    $prefix = hex $prefix;
    if ($prefix != PES_PREFIX) {
#carp "This is not a PES-packet: $prefix $self->{'packet_start_code_prefix'}";
	$self->{'valid'} = 0;
	return;
    } else {
	$self->{'packet_start_code_prefix'} = $prefix;
	$self->{'valid'} = 1;
    }

    if ($self->{'stream_id'} != PROGRAM_STREAM_MAP and
	$self->{'stream_id'} != PADDING_STREAM and
	$self->{'stream_id'} != PRIVATE_STREAM_2 and 
	$self->{'stream_id'} != ECM_STREAM and
	$self->{'stream_id'} != EMM_STREAM and
	$self->{'stream_id'} != PROGRAM_STREAM_DIRECTORY and
	$self->{'stream_id'} != DSMCC_STREAM and
	$self->{'stream_id'} != ITU_222_E) {

# The code below does NOT do what you expect it to. There are subtle issues with un
#packing these things. do not be fooled. It does not work.
#
#			my ($flags, $data) = unpack ("a3 a*", $flags_data);
#			my ($weird,$data) = undef;
#			($weird, 
#			$self->{'PES_scrambling_control'} ,
#			$self->{'PES_priority'} ,
#			$self->{'data_aligmnent_indicator'} ,
#			$self->{'copyright'} ,
#			$self->{'original_or_copy'} ,
#			$self->{'PTS_DTS_flags'} ,
#			$self->{'ESCR_flag'} ,
#			$self->{'ES_rate_flag'} ,
#			$self->{'DSM_trick_mode_flag'} ,
#			$self->{'additional_copy_info_flag'} ,
#			$self->{'CRC_flag'} ,
#			$self->{'extension_flag'} ,
#			$self->{'header_data_length'},
#			$data) = unpack ("B2 B2 B B B B B2 B B B B B B C a*", $flags_data);

#This, however -- does work.
	my @header = unpack("C3", $flags_data);
	my ($data) = unpack("x3 a*", $flags_data);

	my $control_bits = ($header[0] >> 6) & 0x03;
	$self->{'PES_scrambling_control'} = ($header[0] >> 4) & 0x03;
	$self->{'PTS_flag'} = ($header[1] >> 7) & 0x01;
	$self->{'DTS_flag'} = ($header[1] >> 6) & 0x01;
	$self->{'ES_rate_flag'} = ($header[1] >> 4) & 0x01;  #last bit of first nibble in second byte

#			printf("%x\n", $header[1]);
	carp "Weird and confusing (i'm scared mom), no '10($control_bits)' where it should've been" if ($control_bits != 0x2); 

#pull out the payload while we're at it.
	my $header_length = ($header[2]);
	($self->{'payload'}) = unpack("x$header_length a*", $data);

	my $data_pos = 0;
	if ($self->{'PTS_flag'} == 1 and $self->{'DTS_flag'} == 0){
	    $self->_decode_pts($data);
	    $data_pos += 5;
	} elsif ($self->{'PTS_flag'} == 1 and $self->{'DTS_flag'} == 1){
	    $self->_decode_pts_dts($data);
	    $data_pos += 10;
	}

	if ($self->{'ECSR_flag'} eq '1') {
	    my ($ecsr) = unpack ("x$data_pos a*", $data);
	    $self->_decode_ecsr ($ecsr);
	    $data_pos += 6;
	}

	if ($self->{'ES_rate_flag'} eq '1') {
	    my ($es) = unpack ("x$data_pos a*", $data);
	    $self->_decode_es_rate ($es);
	    $data_pos += 3;
	}

	if ($self->{'DSM_trick_mode_flag'} == '1') {
	    my ($trick) = unpack ("x$data_pos a*", $data);
	    $self->_decode_dsm_trick_mode ($trick);
	    $data_pos += 1;	
	}

	if ($self->{'additional_copy_info_flag'} == '1') {
	    my ($addcop) = unpack ("x$data_pos a*", $data);
	    $self->_decode_additional_copy_info ($addcop);
	    $data_pos += 1;	
	}

	if ($self->{'CRC_flag'} == '1') {
	    my ($crc) = unpack ("x$data_pos a*", $data);
	    $self->_decode_CRC ($crc);
	    $data_pos += 2;	
	}

	if ($self->{'extension_flag'} == '1') {
	    my ($ext) = unpack ("x$data_pos a*", $data);
	    $self->_decode_pes_extension ($ext);
#end.
	}
#stuffing bytes and stuff goes here 
    } elsif (
	     $self->{'stream_id'} == PROGRAM_STREAM_MAP or
	     $self->{'stream_id'} == PRIVATE_STREAM_2 or 
	     $self->{'stream_id'} == ECM_STREAM or
	     $self->{'stream_id'} == EMM_STREAM or
	     $self->{'stream_id'} == PROGRAM_STREAM_DIRECTORY or
	     $self->{'stream_id'} == DSMCC_STREAM or
	     $self->{'stream_id'} == ITU_222_E) { 

	$self->{'data'} = unpack ("x3 a*", $flags_data);		
    } elsif ($self->{'stream_id'} == PADDING_STREAM) {
#this isn't very interesting.
    }
}
sub pts_s
{
    my $self = shift;
    my $x = Math::BigFloat->new($self->{'PTS'})/(90000);
    return $x;
}

#This function is BROKEN since bit-unpacking does not behave like expected
sub _decode_es_rate
{
    my $self = shift;
    my ($data) = @_;
    my ($mark, $mark2, $mark3) = undef;
#	print "i shouldn't be here!\n";
    ($mark,
     $mark2,  
     $mark3) = unpack ("B B22 B", $data);
    if ($mark != '1' or $mark3 != '1'){
#		print "oh really\n"22;
	carp "ES_rate marker bits not 1";
    }
    $self->{'ES_rate'} = bin2dec ($mark2);
    return $self->{'ES_rate'};
}


#Unfinished
sub _decode_pts

{
    my $self = shift;
    my ($data) = @_;

    my (@pts) = unpack ("C5", $data);
    my ($p1) = unpack ("H10", $data);
    my $check = ($pts[0] >> 4) & 0x0F;
    

#	my ($pts) = unpack ("B40", $data);
#	my $check = substr($pts, 0, 4);
    if ($check != 0b0010) {
	carp "PTS decoding error. Must-be 0b0010 was $check, dropping packet\n";
	return;
    }

#The 9 next nibbles encodes the PTS, 
#but there's marker bits so we need to shift the data a bit.
# 
#1 byte			2 byte			   		  2 byte
#aaaa xxxb  xxxxxxxxxxxxxxxxxxb xxxxxxxxxxxxxxxxxxb

    my ($bits) = unpack ("B40", $data);
    my $p1 = substr($bits, 4, 3);
    my $p2 = substr($bits, 8, 15);
    my $p3 = substr($bits, 24, 15);
#
#	my $pesv = Bit::Vector->new(40);
#	$pesv->from_Bin($bits);
#
#	$pesv->Delete(36,4);
#	$pesv->Delete(32,1);
#	$pesv->Delete(15,1);
#	$pesv->Delete(0,1);

#	my $pts_decoded = $pesv->to_Dec();
    $self->{'PTS'} = Math::BigInt->new("0b".$p1.$p2.$p3);
}
#TODO:
sub _decode_pts_dts {
#todo!
}
sub _decode_ecsr {}
sub _decode_dsm_trick_mode {}
sub _decode_additional_copy_info {}
sub _decode_CRC {}
sub _decode_pes_extension {}


sub bin2dec 
{
    return unpack("N", pack("B32", substr("0" x 32 . shift, -32)));
}

return (1);

package mpegespacket;

################
#
# Net::MPEG-TS::ES-packet
#
# UNINETT 2009 (www.uninett.no)
# Dabbler in code: Odd Rune S. Lykkebø <lykkebo@pvv.ntnu.no>
#
# References:
# [1] - Wikipedia... 


use strict;
use Carp;

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


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

    my $self = {
	valid => 0,
	start_code => 0x000001B3,
	horizontal_size => undef,
	vertical_size => undef,
	aspect_ratio => undef,
	frame_rate => undef,
	bit_rate => undef,
	rest => undef, # :-)
    }; 
    bless ($self, $class);

    if (defined ($packet)) {
	$self->decode ($packet);
    } else {
#TODO: Encode packet :-) 
    }

    return $self;
}

sub ppme
{
    my $self = shift;

    if($self->{'start_code'} != 0x000001b3) {
	print "NO HEADER IN ELEMENTAL STREAM\n";
	return;
    } 
    printf(	"- ES -\n".
		"Start-code: 0x%x\n".
		"Horizontal: %d\n".
		"Vertical: %d\n".
		"Aspect: %d\n".
		"Frame-rate(fps): %d\n".
		"Byte-rate(actual byte/s): %d\n".
		"- END ES -\n",

		$self->{'start_code'},
		$self->{'horizontal_size'},
		$self->{'vertical_size'},
		$self->{'aspect_ratio'},
		$self->_frame_rate_code($self->{'frame_rate'}),
		(400/8)*$self->{'bit_rate'} );
}

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


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


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

    my ($hor,$ver,$asp,$fr,$br);
    ($self->{'start_code'},
     $hor,
     $ver,
     $asp,
     $fr,
     $br) = unpack ("N H3 H3 H H N", $packet);

    $self->{'horizontal_size'} = hex $hor;
    $self->{'vertical_size'} = hex $ver;
    $self->{'aspect_ratio'} = hex $asp;
    $self->{'frame_rate'} = hex $fr;
    $self->{'bit_rate'} = ($br >> 14) & 0x0003FFFF;
    
    if($self->{'start_code'} != 0x000001B3) {
	carp "Not a ES-packet header ($self->{'start_code'})";
	$self->{'valid'} = 0;
    } else {
	$self->{'valid'} = 1;
    }
}


sub _frame_rate_code
{
    my $code = @_;
    return 30 if $code == 5;
    return 24 if $code == 2;
}
sub bin2dec 
{
    return unpack("N", pack("B32", substr("0" x 32 . shift, -32)));
}

return (1);

=head1 NAME

Qstream - Computes packet stream quality statistics for UDP/RTP/RTMP from network or captured files(pcap)

=head1 DESCRIPTION

Beskrivelse 

=head1 SYNOPSIS

usage="$0 [option]... [file...|ip/|:port]...

=over

=item B<-list> list flows in files

=item B<-dump> dump data part to file

=item B<-format> [full|pretty] print full numbers foror short pretty numbers

=item B<-net> open network stream rather than file(s)

=item B<-ipv6> Listen to Ipv6 connections. Port needs to be defined with -p

=item B<-p> Set port.

=item B<-crude> the log is from crude

=item B<-bins> bins for gaps in ms : b1,b2,,,

=item B<-itme> log gaps longer than 1 (use with crude)

=item B<-rtp> look forinto rtp headers (default just udp)

=item B<-rtt>  roundtrip  - round trip time in ms (for MOS)

=item B<-codec> codec - codec G.711, G.723.1, G.729A, iLBC (G.711)

=item B<-pcap> listen to all multicast groups with pcap at the same time.

=item B<-filename> print filename as source.

=item B<-period> seconds - period in seconds between stats output

=item B<-nperiod> number of periodes

=item B<-last seconds> - exit after seconds

=item B<-packets> packets - exit after packets

=item B<-src source> - limit stats to given source

=item B<-flow_key> flow key - limit stats to this flow(src_ip:src_port->dest_ip:dest_port)

=item B<-flow_no> flow no - limit stats to this flow no from -list

=item B<-flow_min numb>  - discard flows with less packets that numb

=item B<-nohead> - no headings for batch use

=item B<-id name> - report name instead of flow_key in flows

=item B<-name name> - costume name for the tag flow_name in option -xml

=item B<-sum name> - make a summary of all flows to name rather than per flow

=item B<-ttl> - print ttl values for stream

=item B<-verbose> - more details packet distances and sizes

=item B<-debug>  - print debugging info

=item B<-man> - Browse manual pages

=item B<-mpeg> - Decode mpeg-2 transport stream and look for sequence and mediatime

=item B<-xml file> Writes XML to file 

=item B<-q> quiet, dont print anything to STDOUT. 

=item B<-test> Run tests on different datasets. Needs to be used with option -rtp or -mpeg. 

=back

=head2 MPEG-TS

=over 

=item B<-report> Only show statitics of specified streams. example of usage: "-report audio,video" or "report -all" to show all.  

=item B<-new> New statistics. recived and lost MPGE-TS packets. Media loss rate and Delay factor.

=back

=head2 RTMP

=over

=item B<example> RTMP Connects to RTMP stream. Format rtmp://host/app/file rtmp://streamer.uninett.no/live/sdp.cube

=item B<-rtmp> connects to a rtmpstream. 

=item B<-tcp> listen to TCP and to statitics Needs to run as SUDO

=item B<-port> Set port. default is 1935

=item B<-pageurl> Set the url for the html page embeding the flashplayer, needed in some cases.

=item B<-swfurl> Set the url for the flashplayer, needed in some cases

=item B<-flashversion> Set flashplayer version the client should identify it self as. default "LNX 10,0,32,18" 

=back

=head1 Features 

Qstream is a tool to analyse the quality of media streams.
It measures characteristics like packet jitter, loss and gaps, throughput and burstiness, as well as packet sizes. It can read realtime unicast and multicast flows via a socket or through PCAP or even read captured streams in PCAP format. It can analyze RTP on jitter, sequence and timing errors.
It can analyze MPEG Transport streams, meassures PCR jitter and gaps,lost MPEG-TS packets,dwell time, calculates delay factor and Media loss rate[2]. RTMP support

Qstream has scripts to put the data into Stager[1] for aggregation, reports and graphs.

1. http://software.uninett.no/stager
2. http://tools.ietf.org/html/rfc4445
=head1 General 

=over 

=item B<Biterate>

The bitrate measured over the time period set by period/last.

=item B<Gap>

The gap between udp/rtp/tcp packets.

=item B<Setup>

Time it takes to join a multicast group,RTP or RTMP stream. 

=item B<MOS>

Caculated Mean Opinion Score (MOS)

=back

=head1 MPEG

[1] = http://en.wikipedia.org/wiki/MPEG_transport_stream

Decodes a MPEG transport stream [1].

=over 

=item B<PCR jitter>

Program Clock Reference. Jitter between encoder and decoder clock.

delta time = time - last_time 
delta PCR =  PCR - last pcr

PCR jitter =  delta time  - delta PCR 

=item B<PCR GAP>

Gap between since last recived PCR value is sent. 
PCR values should be recived at least every 100 ms.

=item B<Dwell time>

An indicator how big the buffer needs to be in milliseconds.

It calculates how long the packet needs to dwell befor it can be played according to its PTS (Presentation time stamp) that is realtive to the PCR.

Formula: dwell_time = abs(last_pcr_time - PTS)

Dwell time is for audio and video are measure seperatly.

see also http://en.wikipedia.org/wiki/Presentation_time_stamp, PCR

=item B<PID>

The program id (PID) for the transport stream.   


=item B<Stream id/Stream id type>

The id that represent stream type. 

=item B<MPEG TS packets>

Each Ethernet frame containts up to 7 TS packets each 188 bytes large.

Loss of 1 packet would most likely give a visable glitch in the MPEGstream.

Lost: The count of lost mpeg-ts packets.

Media loss rate (MRL):

MRL = (packets_expected - packets_recived) / interval_time_in_seconds

http://en.wikipedia.org/wiki/Media_Delivery_Index

=back 

=head1 RTP

Real time Transport Protocol.
Adds an extra layer on top of UDP that provides it with sequence numbers and time stamps.

http://en.wikipedia.org/wiki/Real-time_Transport_Protocol

=over

=item B<RTP packet stats>

Qstream measures late, lost and duplicated RTP packets based on its seqence numbers.

=item B<RTP jitter>

RTP jitter. The jitter between when the RTP packet was generated and the its arrival time.

=back 

=head1 RTMP (EXPRIMENTAL)

Connect to RTMP stream and analyses RTMP stream.
Uses a modified RTMP client writen in perl can be found at http://search.cpan.org/~chengang/RTMP-Client-0.03/lib/RTMP/Client.pm 

=over

=item B<rtmp>

Example of usage: qstream rtmp://streamer.uninett.no/live/cube1.sdp -rtmp

=item B<Chunk size>

Chunk size set by the RTMP server.

=item B<Window size>

TCP window size. The number of bytes allowed without ACK from client.
	
=item B<RTMP message>

An RTMP message is a series of AMF objects, used to transfer data. All messages start with the standard RTMP header, which for results is always the 12 byte header version.
The AMF objects used are primarily properties of an object, so they all have a name, followed by a value.

=item B<RTMP jitter>

RTMP jitter is based on the timestamp RTMP message header and gap in milliseconds bewteen last packet and current packet. 

=cut

=back

=head1 TCP 

Listen to a TCP while running -RTMP option. 

=over

=back

=head1 Test

mpeg test running: qstream testing/pcap/testdata_mpeg.pcap -mpeg -report audio,video -V
rtp tset running:  qstream  testing/pcap/testdata_rtp.pcap -rtp -V 

Datasets for testing are found in testing/pcap and testing/xml.

=over

=back

=head1 Debian/Ubuntu dependecies 

libnet-ipv6addr-perl