ntploopwatch

Unix/Linux 网络时间协议版本3 Network Time Protocol Version 3 (NTP) distribution for Unix systems

%F_mtime = ();
%F_first = ();
%F_last  = ();

sub genfile
{
    local($cnt,$in,$out,@fpos) = @_;
    
    local(@F,@t,$t,$lastT) = ();
    local(@break,@time,@offs,@freq,@cmpl,@loffset,@filekey) = ();
    local($lm,$l,@f);
    
    local($sdir,$sname);
    
    ;# allocate some storage for the tables
    ;# otherwise realloc may get into troubles
    if (defined($StartTime) && defined($EndTime))
    {
	$l = ($EndTime-$StartTime) -$[+1 +1; # worst case: 1 sample per second
    }
    else
    {
	$l = $cnt + 10;
    }
    print "preextending arrays to $l entries\n" if $verbose > 2;
    $#break =   $l; for ($i=$[; $i<=$l;$i++) { $break[$i] = 0; }
    $#time =    $l; for ($i=$[; $i<=$l;$i++) { $time[$i] = 0; }
    $#offs =    $l; for ($i=$[; $i<=$l;$i++) { $offs[$i] = 0; }
    $#freq =    $l; for ($i=$[; $i<=$l;$i++) { $freq[$i] = 0; }
    $#cmpl =    $l; for ($i=$[; $i<=$l;$i++) { $cmpl[$i] = 0; }
    $#loffset = $l; for ($i=$[; $i<=$l;$i++) { $loffset[$i] = 0; }
    $#filekey = $l; for ($i=$[; $i<=$l;$i++) { $filekey[$i] = 0; }
    ;# now reduce size again
    $#break =   $[ - 1;
    $#time =    $[ - 1;
    $#offs =    $[ - 1;
    $#freq =    $[ - 1;
    $#cmpl =    $[ - 1;
    $#loffset = $[ - 1;
    $#filekey = $[ - 1;
    print "memory allocation ready\n" if $verbose > 2;
    sleep(3) if $verbose > 1;

    if (index($in,"/") < $[)
    {
	$sdir = ".";
	$sname = $in;
    }
    else
    {
	($sdir,$sname) = ($in =~ m!^(.*)/([^/]*)!);
	$sname = "" unless defined($sname);
    }

    if (!defined($Lsdir) || $Lsdir ne $sdir || $Ltime != (stat($sdir))[$[+9] ||
	grep($F_mtime{$_} != (stat($F_name{$_}))[$[+9], @F_files))
	
    {
	print "rescanning directory \"$sdir\" for files \"$sname*\"\n"
	    if $verbose > 1;

	;# rescan directory on changes
	$Lsdir = $sdir;
	$Ltime = (stat($sdir))[$[+9];
	</X{> if 0;		# dummy line - calm down my formatter
	local(@newfiles) = < ${in}*[0-9] >;
	local($st_dev,$st_ino,$st_mtime,$st_size,$name,$key,$modified);

	foreach $name (@newfiles)
	{
	    ($st_dev,$st_ino,$st_size,$st_mtime) =
		(stat($name))[$[,$[+1,$[+7,$[+9];
	    $modified = 0;
	    $key = sprintf("%lx|%lu", $st_dev, $st_ino);
	    
	    print "candidate file \"$name\"",
                  (defined($st_dev) ? "" : " failed: $!"),"\n"
		      if $verbose > 2;
	    
	    if (! defined($F_key{$name}) || $F_key{$name} ne $key)
	    {
		$F_key{$name} = $key;
		$modified++;
	    }
	    if (!defined($F_name{$key}) || $F_name{$key} != $name)
	    {
		$F_name{$key} = $name;
		$modified++;
	    }
	    if (!defined($F_size{$key}) || $F_size{$key} != $st_size)
	    {
		$F_size{$key} = $st_size;
		$modified++;
	    }
	    if (!defined($F_mtime{$key}) || $F_mtime{$key} != $st_mtime)
	    {
		$F_mtime{$key} = $st_mtime;
		$modified++;
	    }
	    if ($modified)
	    {
		print "new data \"$name\" key: $key;\n" if $verbose > 1;
	        print "             size: $st_size; mtime: $st_mtime;\n"
		    if $verbose > 1;
		$F_last{$key} = $F_first{$key} = $st_mtime;
		$F_first{$key}--; # prevent zero divide later on
		;# now compute derivated attributes
		open(IN, "<$name") ||
		    do {
			warn "$0: failed to open \"$name\": $!";
			next;
		    };

		while(<IN>)
		{
		    @F = split;
		    next if @F < 5;
		    next if $F[$[] eq "";
		    $t = ($F[$[] - $MJD_1970) * 24 * 60 * 60;
		    $t += $F[$[+1];
		    $F_first{$key} = $t;
		    print "\tfound first entry: $t ",&ctime($t)
			if $verbose > 4;
		    last;
		}
		seek(IN,
		     ($st_size > 4*$RecordSize) ? $st_size - 4*$RecordSize : 0,
		     0);
		while(<IN>)
		{
		    @F = split;
		    next if @F < 5;
		    next if $F[$[] eq "";
		    $t = ($F[$[] - $MJD_1970) * 24 * 60 * 60;
		    $t += $F[$[+1];
		    $F_last{$key} = $t;
		    $_ = <IN>;
		    print "\tfound last entry: $t ", &ctime($t)
			if $verbose > 4 && ! defined($_);
		    last unless defined($_);
		    redo;
		    ;# Ok, calm down...
		    ;# using $_ = <IN> in conjunction with redo
		    ;# is semantically equivalent to the while loop, but
		    ;# I needed a one line look ahead and this solution
		    ;# was what I thought of first
		    ;# and.. If you do not like it dont look
		}
		close(IN);
		print("             first: ",$F_first{$key},
		      " last: ",$F_last{$key},"\n") if $verbose > 1;
	    }
	}
	;# now reclaim memory used for files no longer referenced ...
	local(%Names);
	grep($Names{$_} = 1,@newfiles);
	foreach (keys %F_key)
	{
	    next if defined($Names{$_});
	    delete $F_key{$_};
	    $verbose > 2 && print "no longer referenced: \"$_\"\n";
	}
	%Names = ();
	
	grep($Names{$_} = 1,values(%F_key));
	foreach (keys %F_name)
	{
	    next if defined($Names{$_});
	    delete $F_name{$_};
	    $verbose > 2 && print "unref name($_)= $F_name{$_}\n";
	}
	foreach (keys %F_size)
	{
	    next if defined($Names{$_});
	    delete $F_size{$_};
	    $verbose > 2 && print "unref size($_)\n";
	}
	foreach (keys %F_mtime)
	{
	    next if defined($Names{$_});
	    delete $F_mtime{$_};
	    $verbose > 2 && print "unref mtime($_)\n";
	}
	foreach (keys %F_first)
	{
	    next if defined($Names{$_});
	    delete $F_first{$_};
	    $verbose > 2 && print "unref first($_)\n";
	}
	foreach (keys %F_last)
	{
	    next if defined($Names{$_});
	    delete $F_last{$_};
	    $verbose > 2 && print "unref last($_)\n";
	}
	;# create list sorted by time
	@F_files = sort {$F_first{$a} <=> $F_first{$b}; } keys(%F_name);
	if ($verbose > 1)
	{
	    print "Resulting file list:\n";
	    foreach (@F_files)
	    {
		print "\t$_\t$F_name{$_}\n";
	    }
	}
    }
    
    printf("processing %s; output \"$out\" (%d input files)\n",
	   ((defined($StartTime) && defined($EndTime))
	    ? "time range"
	    : (defined($StartTime) ? "$cnt samples from StartTime" :
	      (defined($EndTime) ? "$cnt samples to EndTime" :
		 "last $cnt samples"))),
	    scalar(@F_files))
	if $verbose > 1;
    
    ;# open output file - will be input for plotcmd
    open(OUT,">$out") || 
	do {
	    warn("$0: cannot create \"$out\": $!\n");
	};
    
    @f = @F_files;
    if (defined($StartTime))
    {
	while (@f && ($F_last{$f[$[]} < $StartTime))
	{
	    print("shifting ", $F_name{$f[$[]},
		  " last: ", $F_last{$f[$[]},
		  " < StartTime: $StartTime\n")
		if $verbose > 3;
	    shift(@f);
	}


    }
    if (defined($EndTime))
    {
	while (@f && ($F_first{$f[$#f]} > $EndTime))
	{
	    print("popping  ", $F_name{$f[$#f]},
		  " first: ", $F_first{$f[$#f]},
		  " > EndTime: $EndTime\n")
		if $verbose > 3;
	    pop(@f);
	}
    }
    
    if (@f)
    {
	if (defined($StartTime))
	{
	    print "guess start according to StartTime ($StartTime)\n"
		if $verbose > 3;

	    if ($fpos[$[] eq 'start')
	    {
		if (grep($_ eq $fpos[$[+1],@f))
		{
		    shift(@f) while @f && $f[$[] ne $fpos[$[+1];
		}
		else
		{
		    @fpos = ('start', $f[$[], undef);
		}
	    }
	    else
	    {
		@fpos = ('start' , $f[$[], undef);
	    }
	    
	    if (!defined($fpos[$[+2]))
	    {
		if ($StartTime <= $F_first{$f[$[]})
		{
		    $fpos[$[+2] = 0;
		}
		else
		{
		    $fpos[$[+2] =
			int($F_size{$f[$[]} *
			    (($StartTime - $F_first{$f[$[]})/
			     ($F_last{$f[$[]} - $F_first{$f[$[]})));
		    $fpos[$[+2] = ($fpos[$[+2] <= 2 * $RecordSize)
			? 0 : $fpos[$[+2] - 2 * $RecordSize;
		    ;# anyway  as the data may contain "time holes" 
		    ;# our heuristics may baldly fail
		    ;# so just start at 0
		    $fpos[$[+2] = 0;
		}
	    }
	}
	elsif (defined($EndTime))
	{
	    print "guess starting point according to EndTime ($EndTime)\n"
		if $verbose > 3;
	    
	    if ($fpos[$[] eq 'end')
	    {
		if (grep($_ eq $fpos[$[+1],@f))
		{
		    shift(@f) while @f && $f[$[] ne $fpos[$[+1];
		}
		else
		{
		    @fpos = ('end', $f[$[], undef);
		}
	    }
	    else
	    {
		@fpos = ('end', $f[$[], undef);
	    }
	    
	    if (!defined($fpos[$[+2]))
	    {
		local(@x) = reverse(@f);
		local($s,$c) = (0,$cnt);
		if ($EndTime < $F_last{$x[$[]})
		{
		    ;# last file will only be used partially
		    $s = int($F_size{$x[$[]} *
			     (($EndTime - $F_first{$x[$[]}) /
			      ($F_last{$x[$[]} - $F_first{$x[$[]})));
		    $s = int($s/$RecordSize);
		    $c -= $s - 1;
		    if ($c <= 0)
		    {
			;# start is in the same file
			$fpos[$[+1] = $x[$[];
			$fpos[$[+2] = ($c >=-2) ? 0 : (-$c - 2) * $RecordSize;
			shift(@f) while @f && ($f[$[] ne $x[$[]);
		    }
		    else
		    {
			shift(@x);
		    }
		}
		
		if (!defined($fpos[$[+2]))
		{
		    local($_);
		    while($_ = shift(@x))
		    {
			$s = int($F_size{$_}/$RecordSize);
			$c -= $s - 1;
			if ($c <= 0)
			{
			    $fpos[$[+1] = $_;
			    $fpos[$[+2] = ($c>-2) ? 0 : (-$c - 2) * $RecordSize;
			    shift(@f) while @f && ($f[$[] ne $_);
			    last;
			}
		    }
		}
	    }
	}
	else
	{
	    print "guessing starting point according to count ($cnt)\n"
		if $verbose > 3;
	    ;# guess offset to get last available $cnt samples
	    if ($fpos[$[] eq 'cnt')
	    {
		if (grep($_ eq $fpos[$[+1],@f))
		{
		    print "old positioning applies\n" if $verbose > 3;
		    shift(@f) while @f && $f[$[] ne $fpos[$[+1];
		}
		else
		{
		    @fpos = ('cnt', $f[$[], undef);
		}
	    }
	    else
	    {
		@fpos = ('cnt', $f[$[], undef);
	    }
	    
	    if (!defined($fpos[$[+2]))
	    {
		local(@x) = reverse(@f);
		local($s,$c) = (0,$cnt);
		
		local($_);
		while($_ = shift(@x))
		{
		    print "examing \"$_\" $c samples still needed\n"
			if $verbose > 4;
		    $s = int($F_size{$_}/$RecordSize);
		    $c -= $s - 1;
		    if ($c <= 0)
		    {
			$fpos[$[+1] = $_;
			$fpos[$[+2] = ($c>-2) ? 0 : (-$c - 2) * $RecordSize;
			shift(@f) while @f && ($f[$[] ne $_);
			last;
		    }
		}
		if (!defined($fpos[$[+2]))
		{
		    print "no starting point yet - using start of data\n"
			if $verbose > 2;
		    $fpos[$[+2] = 0;
		}
	    }
	}
    }
    print "Ooops, no suitable input file ??\n"
	if $verbose > 1 && @f <= 0;

    printf("Starting at (%s) \"%s\" offset %ld using %d files\n",
	   $fpos[$[+1],
	   $F_name{$fpos[$[+1]},
	   $fpos[$[+2],
	   scalar(@f))
	if $verbose > 2;

    $lm = 1;
    $l = 0;    
    foreach $key (@f)
    {
	$file = $F_name{$key};
	print "processing file \"$file\"\n" if $verbose > 2;
	
	open(IN,"<$file") ||
	    (warn("$0: cannot read \"$file\": $!\n"), next);
	
	;# try to seek to a position nearer to the start of the interesting lines
	;# should always affect only first item in @f
	($key eq $fpos[$[+1]) &&
	    (($verbose > 1) &&
	     print("Seeking to offset $fpos[$[+2]\n"),
		seek(IN,$fpos[$[+2],0) ||
		    warn("$0: seek(\"$F_name{$key}\" failed: $|\n"));
	
	while(<IN>)
	{
	    $l++;
	    ($verbose > 3) &&
		(($l % $lm) == 0 && print("\t$l lines read\n") &&
		 (($l ==     2) && ($lm =    10) ||
		  ($l ==   100) && ($lm =   100) ||
		  ($l ==   500) && ($lm =   500) ||
		  ($l ==  1000) && ($lm =  1000) ||
		  ($l ==  5000) && ($lm =  5000) ||
		  ($l == 10000) && ($lm = 10000)));
	    
	    @F = split;
	    
	    next if @F < 5;	# no valid input line is this short
	    next if $F[$[] eq "";
	    ($F[$[] !~ /^\d+$/) && # A 'never should have happend' error
		die("$0: unexpected input line: $_\n");
	    
	    ;# modified Julian to UNIX epoch
	    $t = ($F[$[] - $MJD_1970) * 24 * 60 * 60;
	    $t += $F[$[+1];	# add seconds + fraction
	    
	    ;# multiply offset by 1000 to get ms - try to avoid float op
	    (($F[$[+2] =~ s/(\d*)\.(\d{3})(\d*)/\1\2.\3/) &&
	     $F[$[+2] =~ s/0+([\d\.])/($1 eq '.') ? '0.' : $1/e) # strip leading zeros
		|| $F[$[+2] *= 1000;

	    
	    ;# skip samples out of specified time range
	    next if (defined($StartTime) && $StartTime > $t);
	    next if (defined($EndTime) && $EndTime < $t);
	    
	    next if defined($lastT) && $t < $lastT; # backward in time ??
	    
	    push(@offs,$F[$[+2]);
	    push(@freq,$F[$[+3] * (2**20/10**6));
	    push(@cmpl,$F[$[+4]);
	    
	    push(@break, (defined($lastT) && ($t - $lastT > $deltaT))); 
	    $lastT = $t;
	    push(@time,$t);
	    push(@loffset, tell(IN) - length($_));
	    push(@filekey, $key);
	    
	    shift(@break),shift(@time),shift(@offs),
	    shift(@freq), shift(@cmpl),shift(@loffset),
	    shift(@filekey)
		if @time > $cnt &&
		    ! (defined($StartTime) && defined($EndTime));

	    last if @time >= $cnt && defined($StartTime) && !defined($EndTime);
	}
	close(IN);
	last if @time >= $cnt && defined($StartTime) && !defined($EndTime);
    }
    print "input scanned ($l lines/",scalar(@time)," samples)\n"
	if $verbose > 1;
    
    &lr_init('offs');
    &lr_init('freq');
    
    if (@time)
    {
	local($_,@F);
	
	local($timebase) unless defined($timebase);
	local($freqbase) unless defined($freqbase);
	local($cmplscale) unless defined($cmplscale);
	
	undef($mintime,$maxtime,$minoffs,$maxoffs,
	      $minfreq,$maxfreq,$mincmpl,$maxcmpl,
	      $miny,$maxy);
	
	print "computing ranges\n" if $verbose > 2;
	
	$LastCnt = @time;

	;# @time is in ascending order (;-)
	$mintime = @time[$[];
	$maxtime = @time[$#time];
	unless (defined($timebase))
	{
	    local($time,@X) = (time);
	    @X = localtime($time);
	    
	    ;# compute today 00:00:00
	    $timebase = $time - ((($X[$[+2]*60)+$X[$[+1])*60+$X[$[]);

	}
	$LastTimeBase = $timebase;

	if ($showoffs)
	{
	    local($i,$m,$f);
	    
	    $minoffs = &min(@offs);
	    $maxoffs = &max(@offs);
	    
	    ;# I know, it is not perl style using indices to access arrays,
	    ;# but I have to proccess two arrays in sync, non-destructively
	    ;# (otherwise a (shift(@a1),shift(a2)) would do),
	    ;# I dont like to make copies of these arrays as they may be huge
	    $i = $[;
	    &lr_sample(($time[$i]-$timebase)/3600,$offs[$i],'offs'),$i++
		while $i <= $#time;

	    ($minoffs == $maxoffs) && ($minoffs -= 0.1,$maxoffs += 0.1);