1632 lines
41 KiB
Perl
Executable File
1632 lines
41 KiB
Perl
Executable File
#!/local/bin/perl -w--*-perl-*-
|
|
;#
|
|
;# ntploopwatch,v 3.1 1993/07/06 01:09:13 jbj Exp
|
|
;#
|
|
;# process loop filter statistics file and either
|
|
;# - show statistics periodically using gnuplot
|
|
;# - or print a single plot
|
|
;#
|
|
;# Copyright (c) 1992
|
|
;# Rainer Pruy Friedrich-Alexander Universitaet Erlangen-Nuernberg
|
|
;#
|
|
;#
|
|
;#############################################################
|
|
$0 =~ s!^.*/([^/]+)$!\1!;
|
|
$F = ' ' x length($0);
|
|
$|=1;
|
|
|
|
$ENV{'SHELL'} = '/bin/sh'; # use bourne shell
|
|
|
|
undef($config);
|
|
undef($workdir);
|
|
undef($PrintIt);
|
|
undef($samples);
|
|
undef($StartTime);
|
|
undef($EndTime);
|
|
($a,$b) if 0; # keep -w happy
|
|
$usage = <<"E-O-P";
|
|
usage:
|
|
to watch statistics permanently:
|
|
$0 [-v[<level>]] [-c <config-file>] [-d <working-dir>]
|
|
$F [-h <hostname>]
|
|
|
|
to get a single print out specify also
|
|
$F -P[<printer>] [-s<samples>]
|
|
$F [-S <start-time>] [-E <end-time>]
|
|
$F [-Y <MaxOffs>] [-y <MinOffs>]
|
|
|
|
If You like long option names, You can use:
|
|
-help
|
|
-c +config
|
|
-d +directory
|
|
-h +host
|
|
-v +verbose[=<level>]
|
|
-P +printer[=<printer>]
|
|
-s +samples[=<samples>]
|
|
-S +starttime
|
|
-E +endtime
|
|
-Y +maxy
|
|
-y +miny
|
|
|
|
If <printer> contains a '/' (slash character) output is directed to
|
|
a file of this name instead of delivered to a printer.
|
|
E-O-P
|
|
|
|
;# add directory to look for lr.pl and timelocal.pl (in front of current list)
|
|
unshift(@INC,"/src/NTP/v3/xntp/monitoring");
|
|
|
|
require "lr.pl"; # linear regresion routines
|
|
|
|
$MJD_1970 = 40587; # from ntp.h (V3)
|
|
$RecordSize = 48; # usually a line fits into 42 bytes
|
|
$MinClip = 0.12; # clip Y scales with greater range than this
|
|
|
|
;# largest extension of Y scale from mean value, factor for standart deviation
|
|
$FuzzLow = 2; # for side closer to zero
|
|
$FuzzBig = 1; # for side farther from zero
|
|
|
|
require "ctime.pl";
|
|
require "timelocal.pl";
|
|
;# early distributions of ctime.pl had a bug
|
|
$ENV{'TZ'} = 'MET' unless defined $ENV{'TZ'} || $[ > 4.010;
|
|
if (defined(@ctime'MoY))
|
|
{
|
|
*Month=*ctime'MoY;
|
|
*Day=*ctime'DoW;
|
|
}
|
|
else
|
|
{
|
|
@Month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
|
|
@Day = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
|
|
}
|
|
;# max number of days per month
|
|
@MaxNumDaysPerMonth = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
|
|
|
|
;# config settable parameters
|
|
$delay = 60;
|
|
$srcprefix = "./var\@\$STATHOST/loopstats.";
|
|
$showoffs = 1;
|
|
$showfreq = 1;
|
|
$showcmpl = 0;
|
|
$showoreg = 0;
|
|
$showfreg = 0;
|
|
undef($timebase);
|
|
undef($freqbase);
|
|
undef($cmplscale);
|
|
undef($MaxY);
|
|
undef($MinY);
|
|
$deltaT = 512; # indicate sample data gaps greater than $deltaT seconds
|
|
$verbose = 1;
|
|
|
|
while($_ = shift(@ARGV))
|
|
{
|
|
(/^[+-]help$/) && die($usage);
|
|
|
|
(/^-c$/ || /^\+config$/) &&
|
|
(@ARGV || die($usage), $config = shift(@ARGV), next);
|
|
|
|
(/^-d$/ || /^\+directory$/) &&
|
|
(@ARGV || die($usage), $workdir = shift(@ARGV), next);
|
|
|
|
(/^-h$/ || /^\+host$/) &&
|
|
(@ARGV || die($usage), $STATHOST = shift, next);
|
|
|
|
(/^-v(\d*)$/ || /^\+verbose=?(\d*)$/) &&
|
|
($verbose=($1 eq "") ? 1 : $1, next);
|
|
|
|
(/^-P(\S*)$/ || /^\+[Pp]rinter=?(\S*)$/) &&
|
|
($PrintIt = $1, $verbose==1 && ($verbose = 0), next);
|
|
|
|
(/^-s(\d*)$/ || /^\+samples=?(\d*)$/) &&
|
|
(($samples = ($1 eq "") ? (shift || die($usage)): $1), next);
|
|
|
|
(/^-S$/ || /^\+[Ss]tart[Tt]ime$/) &&
|
|
(@ARGV || die($usage), $StartTime=&date_time_spec2seconds(shift),next);
|
|
|
|
(/^-E$/ || /^\+[Ee]nd[Tt]ime$/) &&
|
|
(@ARGV || die($usage), $EndTime = &date_time_spec2seconds(shift),next);
|
|
|
|
(/^-Y$/ || /^\+[Mm]ax[Yy]$/) &&
|
|
(@ARGV || die($usage), $MaxY = shift, next);
|
|
|
|
(/^-y$/ || /^\+[Mm]in[Yy]$/) &&
|
|
(@ARGV || die($usage), $MinY = shift, next);
|
|
|
|
die("$0: unexpected argument \"$_\"\n$usage");
|
|
}
|
|
|
|
if (defined($workdir))
|
|
{
|
|
chdir($workdir) ||
|
|
die("$0: failed to change working dir to \"$workdir\": $!\n");
|
|
}
|
|
|
|
$PrintIt = "ps" if defined($PrintIt) && $PrintIt eq "";
|
|
|
|
if (!defined($PrintIt))
|
|
{
|
|
defined($samples) &&
|
|
print "WARNING: your samples value may be shadowed by config file settings\n";
|
|
defined($StartTime) &&
|
|
print "WARNING: your StartTime value may be shadowed by config file settings\n";
|
|
defined($EndTime) &&
|
|
print "WARNING: your EndTime value may be shadowed by config file settings\n";
|
|
defined($MaxY) &&
|
|
print "WARNING: your MaxY value may be shadowed by config file settings\n";
|
|
defined($MinY) &&
|
|
print "WARNING: your MinY value may be shadowed by config file settings\n";
|
|
|
|
;# check operating environment
|
|
;#
|
|
;# gnuplot usually has X support
|
|
;# I vaguely remember there was one with sunview support
|
|
;#
|
|
;# If Your plotcmd can display graphics using some other method
|
|
;# (Tek window,..) fix the following test
|
|
;# (or may be, just disable it)
|
|
;#
|
|
!(defined($ENV{'DISPLAY'}) || defined($ENV{'WINDOW_PARENT'})) &&
|
|
die("Need window system to monitor statistics\n");
|
|
}
|
|
|
|
;# configuration file
|
|
$config = "loopwatch.config" unless defined($config);
|
|
($STATHOST = $config) =~ s!.*loopwatch\.config.([^/\.]*)$!\1!
|
|
unless defined($STATHOST);
|
|
($STATTAG = $STATHOST) =~ s/^([^\.\*\s]+)\..*$/\1/;
|
|
|
|
$srcprefix =~ s/\$STATHOST/$STATHOST/g;
|
|
|
|
;# plot command
|
|
@plotcmd=("gnuplot",
|
|
'-title', "Ntp loop filter statistics $STATHOST",
|
|
'-name', "NtpLoopWatch_$STATTAG");
|
|
$tmpfile = "/tmp/ntpstat.$$";
|
|
|
|
;# other variables
|
|
$doplot = ""; # assembled command for @plotcmd to display plot
|
|
undef($laststat);
|
|
|
|
;# plot value ranges
|
|
undef($mintime);
|
|
undef($maxtime);
|
|
undef($minoffs);
|
|
undef($maxoffs);
|
|
undef($minfreq);
|
|
undef($maxfreq);
|
|
undef($mincmpl);
|
|
undef($maxcmpl);
|
|
undef($miny);
|
|
undef($maxy);
|
|
|
|
;# stop operation if plot command dies
|
|
sub sigchld
|
|
{
|
|
local($pid) = wait;
|
|
unlink($tmpfile);
|
|
warn(sprintf("%s: %s died: exit status: %d signal %d\n",
|
|
$0,
|
|
(defined($Plotpid) && $Plotpid == $pid)
|
|
? "plotcmd" : "unknown child $pid",
|
|
$?>>8,$? & 0xff)) if $?;
|
|
exit(1) if $? && defined($Plotpid) && $pid == $Plotpid;
|
|
}
|
|
&sigchld if 0;
|
|
$SIG{'CHLD'} = "sigchld";
|
|
$SIG{'CLD'} = "sigchld";
|
|
|
|
sub abort
|
|
{
|
|
unlink($tmpfile);
|
|
defined($Plotpid) && kill('TERM',$Plotpid);
|
|
die("$0: received signal SIG$_[$[] - exiting\n");
|
|
}
|
|
&abort if 0; # make -w happy - &abort IS used
|
|
$SIG{'INT'} = $SIG{'HUP'} = $SIG{'QUIT'} = $SIG{'TERM'} = $SIG{'PIPE'} = "abort";
|
|
|
|
;#
|
|
sub abs
|
|
{
|
|
($_[$[] < 0) ? -($_[$[]) : $_[$[];
|
|
}
|
|
|
|
;#####################
|
|
;# start of real work
|
|
|
|
print "starting plot command (" . join(" ",@plotcmd) . ")\n" if $verbose > 1;
|
|
|
|
$Plotpid = open(PLOT,"|-");
|
|
select((select(PLOT),$|=1)[$[]); # make PLOT line bufferd
|
|
|
|
defined($Plotpid) ||
|
|
die("$0: failed to start plot command: $!\n");
|
|
|
|
unless ($Plotpid)
|
|
{
|
|
;# child == plot command
|
|
close(STDOUT);
|
|
open(STDOUT,">&STDERR") ||
|
|
die("$0: failed to redirect STDOUT of plot command: $!\n");
|
|
|
|
print STDOUT "plot command running as $$\n";
|
|
|
|
exec @plotcmd;
|
|
die("$0: failed to exec (@plotcmd): $!\n");
|
|
exit(1); # in case ...
|
|
}
|
|
|
|
sub read_config
|
|
{
|
|
local($at) = (stat($config))[$[+9];
|
|
local($_,$c,$v);
|
|
|
|
(undef($laststat),(print("stat $config failed: $!\n")),return) if ! defined($at);
|
|
return if (defined($laststat) && ($laststat == $at));
|
|
$laststat = $at;
|
|
|
|
print "reading configuration from \"$config\"\n" if $verbose;
|
|
|
|
open(CF,"<$config") ||
|
|
(warn("$0: failed to read \"$config\" - using old settings ($!)\n"),
|
|
return);
|
|
while(<CF>)
|
|
{
|
|
chop;
|
|
s/^([^\#]*[^\#\s]?)\s*\#.*$//;
|
|
next if /^\s*$/;
|
|
|
|
s/^\s*([^=\s]*)\s*=\s*(.*\S)\s*$/\1=\2/;
|
|
|
|
($c,$v) = split(/=/,$_,2);
|
|
print "processing \"$c=$v\"\n" if $verbose > 3;
|
|
($c eq "delay") && ($delay = $v,1) && next;
|
|
($c eq 'samples') && (!defined($PrintIt) || !defined($samples)) &&
|
|
($samples = $v,1) && next;
|
|
($c eq 'srcprefix') && (($srcprefix=$v)=~s/\$STATHOST/$STATHOST/g,1)
|
|
&& next;
|
|
($c eq 'showoffs') &&
|
|
($showoffs = ($v eq 'yes' || $v eq 'y' || $v != 0),1) && next;
|
|
($c eq 'showfreq') &&
|
|
($showfreq = ($v eq 'yes' || $v eq 'y' || $v != 0),1) && next;
|
|
($c eq 'showcmpl') &&
|
|
($showcmpl = ($v eq 'yes' || $v eq 'y' || $v != 0),1) && next;
|
|
($c eq 'showoreg') &&
|
|
($showoreg = ($v eq 'yes' || $v eq 'y' || $v != 0),1) && next;
|
|
($c eq 'showfreg') &&
|
|
($showfreg = ($v eq 'yes' || $v eq 'y' || $v != 0),1) && next;
|
|
|
|
($c eq 'exit') && (unlink($tmpfile),die("$0: exit by config request\n"));
|
|
|
|
($c eq 'freqbase' ||
|
|
$c eq 'cmplscale') &&
|
|
do {
|
|
if (! defined($v) || $v eq "" || $v eq 'dynamic')
|
|
{
|
|
eval "undef(\$$c);";
|
|
}
|
|
else
|
|
{
|
|
eval "\$$c = \$v;";
|
|
}
|
|
next;
|
|
};
|
|
($c eq 'timebase') &&
|
|
do {
|
|
if (! defined($v) || $v eq "" || $v eq "dynamic")
|
|
{
|
|
undef($timebase);
|
|
}
|
|
else
|
|
{
|
|
$timebase=&date_time_spec2seconds($v);
|
|
}
|
|
};
|
|
($c eq 'EndTime') &&
|
|
do {
|
|
next if defined($EndTime) && defined($PrintIt);
|
|
if (! defined($v) || $v eq "" || $v eq "none")
|
|
{
|
|
undef($EndTime);
|
|
}
|
|
else
|
|
{
|
|
$EndTime=&date_time_spec2seconds($v);
|
|
}
|
|
};
|
|
($c eq 'StartTime') &&
|
|
do {
|
|
next if defined($StartTime) && defined($PrintIt);
|
|
if (! defined($v) || $v eq "" || $v eq "none")
|
|
{
|
|
undef($StartTime);
|
|
}
|
|
else
|
|
{
|
|
$StartTime=&date_time_spec2seconds($v);
|
|
}
|
|
};
|
|
|
|
($c eq 'MaxY') &&
|
|
do {
|
|
next if defined($MaxY) && defined($PrintIt);
|
|
if (! defined($v) || $v eq "" || $v eq "none")
|
|
{
|
|
undef($MaxY);
|
|
}
|
|
else
|
|
{
|
|
$MaxY=$v;
|
|
}
|
|
};
|
|
|
|
($c eq 'MinY') &&
|
|
do {
|
|
next if defined($MinY) && defined($PrintIt);
|
|
if (! defined($v) || $v eq "" || $v eq "none")
|
|
{
|
|
undef($MinY);
|
|
}
|
|
else
|
|
{
|
|
$MinY=$v;
|
|
}
|
|
};
|
|
|
|
($c eq 'deltaT') &&
|
|
do {
|
|
if (!defined($v) || $v eq "")
|
|
{
|
|
undef($deltaT);
|
|
}
|
|
else
|
|
{
|
|
$deltaT = $v;
|
|
}
|
|
next;
|
|
};
|
|
($c eq 'verbose') && ! defined($PrintIt) &&
|
|
do {
|
|
if (!defined($v) || $v == 0)
|
|
{
|
|
$verbose = 0;
|
|
}
|
|
else
|
|
{
|
|
$verbose = $v;
|
|
}
|
|
next;
|
|
};
|
|
;# otherwise: silently ignore unrecognized config line
|
|
}
|
|
close(CF);
|
|
;# set show defaults when nothing selected
|
|
$showoffs = $showfreq = $showcmpl = 1
|
|
unless $showoffs || $showfreq || $showcmpl;
|
|
if ($verbose > 3)
|
|
{
|
|
print "new configuration:\n";
|
|
print " delay\t= $delay\n";
|
|
print " samples\t= $samples\n";
|
|
print " srcprefix\t= $srcprefix\n";
|
|
print " showoffs\t= $showoffs\n";
|
|
print " showfreq\t= $showfreq\n";
|
|
print " showcmpl\t= $showcmpl\n";
|
|
print " showoreg\t= $showoreg\n";
|
|
print " showfreg\t= $showfreg\n";
|
|
printf " timebase\t= %s",defined($timebase)?&ctime($timebase):"dynamic\n";
|
|
printf " freqbase\t= %s\n",defined($freqbase) ?"$freqbase":"dynamic";
|
|
printf " cmplscale\t= %s\n",defined($cmplscale)?"$cmplscale":"dynamic";
|
|
printf " StartTime\t= %s",defined($StartTime)?&ctime($StartTime):"none\n";
|
|
printf " EndTime\t= %s", defined($EndTime) ? &ctime($EndTime):"none\n";
|
|
printf " MaxY\t= %s",defined($MaxY)? $MaxY :"none\n";
|
|
printf " MinY\t= %s",defined($MinY)? $MinY :"none\n";
|
|
print " verbose\t= $verbose\n";
|
|
}
|
|
print "configuration file read\n" if $verbose > 2;
|
|
}
|
|
|
|
sub make_doplot
|
|
{
|
|
local($c) = ("");
|
|
local($fmt)
|
|
= ("%s \"%s\" using 1:%d title '%s <%lf %lf> %6s' with lines");
|
|
local($regfmt)
|
|
= ("%s ((%lf * x) + %lf) title 'lin. approx. %s (%f t[h]) %s %f <%f> %6s' with lines");
|
|
|
|
$doplot = " set title 'NTP loopfilter statistics for $STATHOST " .
|
|
"(last $LastCnt samples from $srcprefix*)'\n";
|
|
|
|
local($xts,$xte,$i,$t);
|
|
|
|
local($s,$c) = ("");
|
|
|
|
;# number of integral seconds to get at least 12 tic marks on x axis
|
|
$t = int(($maxtime - $mintime) / 12 + 0.5);
|
|
$t = 1 unless $t; # prevent $t to be zero
|
|
foreach $i (30,
|
|
60,5*60,15*60,30*60,
|
|
60*60,2*60*60,6*60*60,12*60*60,
|
|
24*60*60,48*60*60)
|
|
{
|
|
last if $t < $i;
|
|
$t = $t - ($t % $i);
|
|
}
|
|
print "time label resolution: $t seconds\n" if $verbose > 1;
|
|
|
|
;# make gnuplot use wall clock time labels instead of NTP seconds
|
|
for ($c="", $i = $mintime - ($mintime % $t);
|
|
$i <= $maxtime + $t;
|
|
$i += $t, $c=",")
|
|
{
|
|
$s .= $c;
|
|
((int($i / $t) % 2) &&
|
|
($s .= sprintf("'' %lf",($i - $LastTimeBase)/3600))) ||
|
|
(($t <= 60) &&
|
|
($s .= sprintf("'%d:%02d:%02d' %lf",
|
|
(localtime($i))[$[+2,$[+1,$[+0],
|
|
($i - $LastTimeBase)/3600)))
|
|
|| (($t <= 2*60*60) &&
|
|
($s .= sprintf("'%d:%02d' %lf",
|
|
(localtime($i))[$[+2,$[+1],
|
|
($i - $LastTimeBase)/3600)))
|
|
|| (($t <= 12*60*60) &&
|
|
($s .= sprintf("'%s %d:00' %lf",
|
|
$Day[(localtime($i))[$[+6]],
|
|
(localtime($i))[$[+2],
|
|
($i - $LastTimeBase)/3600)))
|
|
|| ($s .= sprintf("'%d.%d-%d:00' %lf",
|
|
(localtime($i))[$[+3,$[+4,$[+2],
|
|
($i - $LastTimeBase)/3600));
|
|
}
|
|
$doplot .= "set xtics ($s)\n";
|
|
|
|
chop($xts = &ctime($mintime));
|
|
chop($xte = &ctime($maxtime));
|
|
$doplot .= "set xlabel 'Start: $xts -- Time Scale -- End: $xte'\n";
|
|
$doplot .= "set yrange [" ;
|
|
$doplot .= defined($MinY) ? sprintf("%lf", $MinY) : $miny;
|
|
$doplot .= ':';
|
|
$doplot .= defined($MaxY) ? sprintf("%lf", $MaxY) : $maxy;
|
|
$doplot .= "]\n";
|
|
|
|
$doplot .= " plot";
|
|
$c = "";
|
|
$showoffs &&
|
|
($doplot .= sprintf($fmt,$c,$tmpfile,2,
|
|
"offset",
|
|
$minoffs,$maxoffs,
|
|
"[ms]"),
|
|
$c = ",");
|
|
$showcmpl &&
|
|
($doplot .= sprintf($fmt,$c,$tmpfile,4,
|
|
"compliance" .
|
|
(&abs($LastCmplScale) > 1
|
|
? " / $LastCmplScale"
|
|
: (&abs($LastCmplScale) == 1 ? "" : " * ".(1/$LastCmplScale))),
|
|
$mincmpl/$LastCmplScale,$maxcmpl/$LastCmplScale,
|
|
""),
|
|
$c = ",");
|
|
$showfreq &&
|
|
($doplot .= sprintf($fmt,$c,$tmpfile,3,
|
|
"frequency" .
|
|
($LastFreqBase > 0
|
|
? " - $LastFreqBaseString"
|
|
: ($LastFreqBase == 0 ? "" : " + $LastFreqBaseString")),
|
|
$minfreq * $FreqScale - $LastFreqBase,
|
|
$maxfreq * $FreqScale - $LastFreqBase,
|
|
"[${FreqScaleInv}ppm]"),
|
|
$c = ",");
|
|
$showoreg && $showoffs &&
|
|
($doplot .= sprintf($regfmt, $c,
|
|
&lr_B('offs'),&lr_A('offs'),
|
|
"offset ",
|
|
&lr_B('offs'),
|
|
((&lr_A('offs')) < 0 ? '-' : '+'),
|
|
&abs(&lr_A('offs')), &lr_r('offs'),
|
|
"[ms]"),
|
|
$c = ",");
|
|
$showfreg && $showfreq &&
|
|
($doplot .= sprintf($regfmt, $c,
|
|
&lr_B('freq') * $FreqScale,
|
|
(&lr_A('freq') + $minfreq) * $FreqScale - $LastFreqBase,
|
|
"frequency",
|
|
&lr_B('freq') * $FreqScale,
|
|
((&lr_A('freq') + $minfreq) * $FreqScale - $LastFreqBase) < 0 ? '-' : '+',
|
|
&abs((&lr_A('freq') + $minfreq) * $FreqScale - $LastFreqBase),
|
|
&lr_r('freq'),
|
|
"[${FreqScaleInv}ppm]"),
|
|
$c = ",");
|
|
$doplot .= "\n";
|
|
}
|
|
|
|
%F_key = ();
|
|
%F_name = ();
|
|
%F_size = ();
|
|
%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);
|
|
|
|
$i = &lr_sigma('offs');
|
|
$m = &lr_mean('offs');
|
|
|
|
print "mean offset: $m sigma: $i\n" if $verbose > 2;
|
|
|
|
if (($maxoffs - $minoffs) > $MinClip)
|
|
{
|
|
$f = (&abs($minoffs) < &abs($maxoffs)) ? $FuzzLow : $FuzzBig;
|
|
$miny = (($m - $minoffs) <= ($f * $i))
|
|
? $minoffs : ($m - $f * $i);
|
|
$f = ($f == $FuzzLow) ? $FuzzBig : $FuzzLow;
|
|
$maxy = (($maxoffs - $m) <= ($f * $i))
|
|
? $maxoffs : ($m + $f * $i);
|
|
}
|
|
else
|
|
{
|
|
$miny = $minoffs;
|
|
$maxy = $maxoffs;
|
|
}
|
|
($maxy-$miny) == 0 &&
|
|
(($maxy,$miny)
|
|
= (($maxoffs - $minoffs) > 0)
|
|
? ($maxoffs,$minoffs) : ($MinClip,-$MinClip));
|
|
|
|
$maxy = $MaxY if defined($MaxY) && $MaxY < $maxy;
|
|
$miny = $MinY if defined($MinY) && $MinY > $miny;
|
|
|
|
print "offset min clipped from $minoffs to $miny\n"
|
|
if $verbose > 2 && $minoffs != $miny;
|
|
print "offset max clipped from $maxoffs to $maxy\n"
|
|
if $verbose > 2 && $maxoffs != $maxy;
|
|
}
|
|
|
|
if ($showfreq)
|
|
{
|
|
local($i,$m);
|
|
|
|
$minfreq = &min(@freq);
|
|
$maxfreq = &max(@freq);
|
|
|
|
$i = $[;
|
|
&lr_sample(($time[$i]-$timebase)/3600,$freq[$i]-$minfreq,'freq'),
|
|
$i++
|
|
while $i <= $#time;
|
|
|
|
$i = &lr_sigma('freq');
|
|
$m = &lr_mean('freq') + $minfreq;
|
|
|
|
print "mean frequency: $m sigma: $i\n" if $verbose > 2;
|
|
|
|
if (defined($maxy))
|
|
{
|
|
local($s) =
|
|
($maxfreq - $minfreq)
|
|
? ($maxy - $miny) / ($maxfreq - $minfreq) : 1;
|
|
|
|
if (defined($freqbase))
|
|
{
|
|
$FreqScale = 1;
|
|
$FreqScaleInv = "";
|
|
}
|
|
else
|
|
{
|
|
$FreqScale = 1;
|
|
$FreqScale = 10 ** int(log($s)/log(10) - 0.8);
|
|
$FreqScaleInv =
|
|
("$FreqScale" =~ /^10(0*)$/) ? "0.${1}1" :
|
|
($FreqScale == 1 ? "" : (1/$FreqScale));
|
|
|
|
$freqbase = $m * $FreqScale;
|
|
$freqbase -= &lr_mean('offs');
|
|
|
|
;# round resulting freqbase
|
|
;# to precision of min max difference
|
|
$s = int(log(($maxfreq-$minfreq)*$FreqScale)/log(10))-1;
|
|
$s = 10 ** $s;
|
|
$freqbase = int($freqbase / $s) * $s;
|
|
}
|
|
}
|
|
else
|
|
{
|
|
$FreqScale = 1;
|
|
$FreqScaleInv = "";
|
|
$freqbase = $m unless defined($freqbase);
|
|
if (($maxfreq - $minfreq) > $MinClip)
|
|
{
|
|
$f = (&abs($minfreq) < &abs($maxfreq))
|
|
? $FuzzLow : $FuzzBig;
|
|
$miny = (($freqbase - $minfreq) <= ($f * $i))
|
|
? ($minfreq-$freqbase) : (- $f * $i);
|
|
$f = ($f == $FuzzLow) ? $FuzzBig : $FuzzLow;
|
|
$maxy = (($maxfreq - $freqbase) <= ($f * $i))
|
|
? ($maxfreq-$freqbase) : ($f * $i);
|
|
}
|
|
else
|
|
{
|
|
$miny = $minfreq - $freqbase;
|
|
$maxy = $maxfreq - $freqbase;
|
|
}
|
|
($maxy - $miny) == 0 &&
|
|
(($maxy,$miny) =
|
|
(($maxfreq - $minfreq) > 0)
|
|
? ($maxfreq-$freqbase,$minfreq-$freqbase) : (0.5,-0.5));
|
|
|
|
$maxy = $MaxY if defined($MaxY) && $MaxY < $maxy;
|
|
$miny = $MinY if defined($MinY) && $MinY > $miny;
|
|
|
|
print("frequency min clipped from ",$minfreq-$freqbase,
|
|
" to $miny\n")
|
|
if $verbose > 2 && $miny != ($minfreq - $freqbase);
|
|
print("frequency max clipped from ",$maxfreq-$freqbase,
|
|
" to $maxy\n")
|
|
if $verbose > 2 && $maxy != ($maxfreq - $freqbase);
|
|
}
|
|
$LastFreqBaseString =
|
|
sprintf("%g",$freqbase >= 0 ? $freqbase : -$freqbase);
|
|
$LastFreqBase = $freqbase;
|
|
print "LastFreqBaseString now \"$LastFreqBaseString\"\n"
|
|
if $verbose > 5;
|
|
}
|
|
else
|
|
{
|
|
$FreqScale = 1;
|
|
$FreqScaleInv = "";
|
|
$LastFreqBase = 0;
|
|
$LastFreqBaseString = "";
|
|
}
|
|
|
|
if ($showcmpl)
|
|
{
|
|
$mincmpl = &min(@cmpl);
|
|
$maxcmpl = &max(@cmpl);
|
|
|
|
if (!defined($cmplscale))
|
|
{
|
|
if (defined($maxy))
|
|
{
|
|
local($cmp)
|
|
= (&abs($miny) > &abs($maxy)) ? &abs($miny) : $maxy;
|
|
$cmplscale = $cmp == $maxy ? 1 : -1;
|
|
|
|
foreach (0.01, 0.02, 0.05,
|
|
0.1, 0.2, 0.25, 0.4, 0.5,
|
|
1, 2, 4, 5,
|
|
10, 20, 25, 50,
|
|
100, 200, 250, 500, 1000)
|
|
{
|
|
$cmplscale *= $_, last if $maxcmpl/$_ <= $cmp;
|
|
}
|
|
}
|
|
else
|
|
{
|
|
$cmplscale = 1;
|
|
$miny = $mincmpl ? 0 : -$MinClip;
|
|
$maxy = $maxcmpl+$MinClip;
|
|
}
|
|
}
|
|
$LastCmplScale = $cmplscale;
|
|
}
|
|
else
|
|
{
|
|
$LastCmplScale = 1;
|
|
}
|
|
|
|
print "creating plot command input file\n" if $verbose > 2;
|
|
|
|
|
|
print OUT ("# preprocessed NTP statistics file for $STATHOST\n");
|
|
print OUT ("# timebase is: ",&ctime($LastTimeBase))
|
|
if defined($LastTimeBase);
|
|
print OUT ("# frequency is offset by ",
|
|
($LastFreqBase >= 0 ? "+" : "-"),
|
|
"$LastFreqBaseString [${FreqScaleInv}ppm]\n");
|
|
print OUT ("# compliance is scaled by $LastCmplScale\n");
|
|
print OUT ("# time [h]\toffset [ms]\tfrequency [${FreqScaleInv}ppm]\tcompliance\n");
|
|
|
|
printf OUT ("%s%lf\t%lf\t%lf\t%lf\n",
|
|
(shift(@break) ? "\n" : ""),
|
|
(shift(@time) - $LastTimeBase)/3600,
|
|
shift(@offs),
|
|
shift(@freq) * $FreqScale - $LastFreqBase,
|
|
shift(@cmpl) / $LastCmplScale)
|
|
while(@time);
|
|
}
|
|
else
|
|
{
|
|
;# prevent plotcmd from processing empty file
|
|
print "Creating plot command dummy...\n" if $verbose > 2;
|
|
print OUT "# dummy samples\n0 1 2 3\n1 1 2 3\n";
|
|
&lr_sample(0,1,'offs');
|
|
&lr_sample(1,1,'offs');
|
|
&lr_sample(0,2,'freq');
|
|
&lr_sample(1,2,'freq');
|
|
@time = (0, 1); $maxtime = 1; $mintime = 0;
|
|
@offs = (1, 1); $maxoffs = 1; $minoffs = 1;
|
|
@freq = (2, 2); $maxfreq = 2; $minfreq = 2;
|
|
@cmpl = (3, 3); $maxcmpl = 3; $mincmpl = 3;
|
|
$LastCnt = 2;
|
|
$LastFreqBase = 0;
|
|
$LastCmplScale = 1;
|
|
$LastTimeBase = 0;
|
|
$miny = -$MinClip;
|
|
$maxy = 3 + $MinClip;
|
|
}
|
|
close(OUT);
|
|
|
|
print "plot command input file created\n"
|
|
if $verbose > 2;
|
|
|
|
if (($fpos[$[] eq 'cnt' && @loffset >= $cnt) ||
|
|
($fpos[$[] eq 'start' && $time[$[] <= $StartTime) ||
|
|
($fpos[$[] eq 'end'))
|
|
{
|
|
return ($fpos[$[],$filekey[$[],$loffset[$[]);
|
|
}
|
|
else # found to few lines - next time start search earlier in file
|
|
{
|
|
if ($fpos[$[] eq 'start')
|
|
{
|
|
;# the timestamps we got for F_first and F_last guaranteed
|
|
;# that no file is left out
|
|
;# the only thing that could happen is:
|
|
;# we guessed the starting point wrong
|
|
;# compute a new guess from the first record found
|
|
;# if this equals our last guess use data of first record
|
|
;# otherwise try new guess
|
|
|
|
if ($fpos[$[+1] eq $filekey[$[] && $loffset[$[] > $fpos[$[+2])
|
|
{
|
|
local($noff);
|
|
$noff = $loffset[$[] - ($cnt - @loffset + 1) * $RecordSize;
|
|
$noff = 0 if $noff < 0;
|
|
|
|
return (@fpos[$[,$[+1], ($noff == $fpos[$[+2]) ? $loffset[$[] : $noff);
|
|
}
|
|
return ($fpos[$[],$filekey[$[],$loffset[$[]);
|
|
}
|
|
elsif ($fpos[$[] eq 'end' || $fpos[$[] eq 'cnt')
|
|
{
|
|
;# try to start earlier in file
|
|
;# if we already started at the beginning
|
|
;# try to use previous file
|
|
;# this assumes distance to better starting point is at most one file
|
|
;# the primary guess at top of genfile() should usually allow this
|
|
;# assumption
|
|
;# if the offset of the first sample used is within
|
|
;# a different file than we guessed it must have occured later
|
|
;# in the sequence of files
|
|
;# this only can happen if our starting file did not contain
|
|
;# a valid sample from the starting point we guessed
|
|
;# however this does not invalidate our assumption, no check needed
|
|
local($noff,$key);
|
|
if ($fpos[$[+2] > 0)
|
|
{
|
|
$noff = $fpos[$[+2] - $RecordSize * ($cnt - @loffset + 1);
|
|
$noff = 0 if $noff < 0;
|
|
return (@fpos[$[,$[+1],$noff);
|
|
}
|
|
else
|
|
{
|
|
if ($fpos[$[+1] eq $F_files[$[])
|
|
{
|
|
;# first file - and not enough samples
|
|
;# use data of first sample
|
|
return ($fpos[$[], $filekey[$[], $loffset[$[]);
|
|
}
|
|
else
|
|
{
|
|
;# search key of previous file
|
|
$key = $F_files[$[];
|
|
@F = reverse(@F_files);
|
|
while ($_ = shift(@F))
|
|
{
|
|
if ($_ eq $fpos[$[+1])
|
|
{
|
|
$key = shift(@F) if @F;
|
|
last;
|
|
}
|
|
}
|
|
$noff = int($F_size{$key} / $RecordSize);
|
|
$noff -= $cnt - @loffset;
|
|
$noff = 0 if $noff < 0;
|
|
$noff *= $RecordSize;
|
|
return ($fpos[$[], $key, $noff);
|
|
}
|
|
}
|
|
}
|
|
else
|
|
{
|
|
return ();
|
|
}
|
|
|
|
return 0 if @loffset <= 1 || ($loffset[$#loffset] - $loffset[$[]) <= 1;
|
|
|
|
;# EOF - 1.1 * avg(line) * $cnt
|
|
local($val) = $loffset[$#loffset]
|
|
- $cnt * 11 * (($loffset[$#loffset] - $loffset[$[]) / @loffset) / 10;
|
|
return ($val < 0) ? 0 : $val;
|
|
}
|
|
}
|
|
|
|
;# initial setup of plot
|
|
print "initialize plotting\n" if $verbose;
|
|
if (defined($PrintIt))
|
|
{
|
|
if ($PrintIt =~ m,/,)
|
|
{
|
|
print "Saving plot to file $PrintIt\n";
|
|
print PLOT "set output '$PrintIt'\n";
|
|
}
|
|
else
|
|
{
|
|
print "Printing plot on printer $PrintIt\n";
|
|
print PLOT "set output '| lpr -P$PrintIt -h'\n";
|
|
}
|
|
print PLOT "set terminal postscript landscape color solid 'Helvetica' 10\n";
|
|
}
|
|
print PLOT "set grid\n";
|
|
print PLOT "set tics out\n";
|
|
print PLOT "set format y '%g '\n";
|
|
printf PLOT "set time 47\n" unless defined($PrintIt);
|
|
|
|
@filepos =();
|
|
while(1)
|
|
{
|
|
print &ctime(time) if $verbose;
|
|
|
|
;# update diplay characteristics
|
|
&read_config;# unless defined($PrintIt);
|
|
|
|
unlink($tmpfile);
|
|
@filepos = &genfile($samples,$srcprefix,$tmpfile,@filepos);
|
|
|
|
;# make plotcmd display samples
|
|
&make_doplot;
|
|
print "Displaying plot...\n" if $verbose > 1;
|
|
print "command for plot sub process:\n$doplot----\n" if $verbose > 3;
|
|
print PLOT $doplot;
|
|
}
|
|
continue
|
|
{
|
|
if (defined($PrintIt))
|
|
{
|
|
delete $SIG{'CHLD'};
|
|
print PLOT "quit\n";
|
|
close(PLOT);
|
|
if ($PrintIt =~ m,/,)
|
|
{
|
|
print "Plot saved to file $PrintIt\n";
|
|
}
|
|
else
|
|
{
|
|
print "Plot spooled to printer $PrintIt\n";
|
|
}
|
|
unlink($tmpfile);
|
|
exit(0);
|
|
}
|
|
;# wait $delay seconds
|
|
print "waiting $delay seconds ..." if $verbose > 2;
|
|
sleep($delay);
|
|
print " continuing\n" if $verbose > 2;
|
|
undef($LastFreqBaseString);
|
|
}
|
|
|
|
|
|
sub date_time_spec2seconds
|
|
{
|
|
local($_) = @_;
|
|
;# a date_time_spec consistes of:
|
|
;# YYYY-MM-DD_HH:MM:SS.ms
|
|
;# values can be omitted from the beginning and default than to
|
|
;# values of current date
|
|
;# values omitted from the end default to lowest possible values
|
|
|
|
local($time) = time;
|
|
local($sec,$min,$hour,$mday,$mon,$year)
|
|
= localtime($time);
|
|
|
|
local($last) = ();
|
|
|
|
s/^\D*(.*\d)\D*/\1/; # strip off garbage
|
|
|
|
PARSE:
|
|
{
|
|
if (s/^(\d{4})(-|$)//)
|
|
{
|
|
if ($1 < 1970)
|
|
{
|
|
warn("$0: can not handle years before 1970 - year $1 ignored\n");
|
|
return undef;
|
|
}
|
|
elsif ( $1 >= 2070)
|
|
{
|
|
warn("$0: can not handle years past 2070 - year $1 ignored\n");
|
|
return undef;
|
|
}
|
|
else
|
|
{
|
|
$year = $1 % 100; # 0<= $year < 100
|
|
;# - interpreted 70 .. 99,00 .. 69
|
|
}
|
|
$last = $[ + 5;
|
|
last PARSE if $_ eq '';
|
|
warn("$0: bad date_time_spec: \"$_\" found after YEAR\n"),
|
|
return(undef)
|
|
if $2 eq '';
|
|
}
|
|
|
|
if (s/^(\d{1,2})(-|$)//)
|
|
{
|
|
warn("$0: implausible month $1\n"),return(undef)
|
|
if $1 < 1 || $1 > 12;
|
|
$mon = $1 - 1;
|
|
$last = $[ + 4;
|
|
last PARSE if $_ eq '';
|
|
warn("$0: bad date_time_spec: \"$_\" found after MONTH\n"),
|
|
return(undef)
|
|
if $2 eq '';
|
|
}
|
|
else
|
|
{
|
|
warn("$0: bad date_time_spec \"$_\"\n"),return(undef)
|
|
if defined($last);
|
|
|
|
}
|
|
|
|
if (s/^(\d{1,2})([_ ]|$)//)
|
|
{
|
|
warn("$0: implausible month day $1 for month ".($mon+1)." (".
|
|
$MaxNumDaysPerMonth[$mon].")$mon\n"),
|
|
return(undef)
|
|
if $1 < 1 || $1 > $MaxNumDaysPerMonth[$mon];
|
|
$mday = $1;
|
|
$last = $[ + 3;
|
|
last PARSE if $_ eq '';
|
|
warn("$0: bad date_time_spec \"$_\" found after MDAY\n"),
|
|
return(undef)
|
|
if $2 eq '';
|
|
}
|
|
else
|
|
{
|
|
warn("$0: bad date_time_spec \"$_\"\n"), return undef
|
|
if defined($last);
|
|
}
|
|
|
|
;# now we face a problem:
|
|
;# if ! defined($last) a prefix of "07:"
|
|
;# can be either 07:MM or 07:ss
|
|
;# to get the second interpretation make the user add
|
|
;# a msec fraction part and check for this special case
|
|
if (! defined($last) && s/^(\d{1,2}):(\d{1,2}\.\d+)//)
|
|
{
|
|
warn("$0: implausible minute $1\n"), return undef
|
|
if $1 < 0 || $1 >= 60;
|
|
warn("$0: implausible second $1\n"), return undef
|
|
if $2 < 0 || $2 >= 60;
|
|
$min = $1;
|
|
$sec = $2;
|
|
$last = $[ + 1;
|
|
last PARSE if $_ eq '';
|
|
warn("$0: bad date_time_spec \"$_\" after SECONDS\n");
|
|
return undef;
|
|
}
|
|
|
|
if (s/^(\d{1,2})(:|$)//)
|
|
{
|
|
warn("$0: implausible hour $1\n"), return undef
|
|
if $1 < 0 || $1 > 24;
|
|
$hour = $1;
|
|
$last = $[ + 2;
|
|
last PARSE if $_ eq '';
|
|
warn("$0: bad date_time_spec found \"$_\" after HOUR\n"),
|
|
return undef
|
|
if $2 eq '';
|
|
}
|
|
else
|
|
{
|
|
warn("$0: bad date_time_spec \"$_\"\n"), return undef
|
|
if defined($last);
|
|
}
|
|
|
|
if (s/^(\d{1,2})(:|$)//)
|
|
{
|
|
warn("$0: implausible minute $1\n"), return undef
|
|
if $1 < 0 || $1 >=60;
|
|
$min = $1;
|
|
$last = $[ + 1;
|
|
last PARSE if $_ eq '';
|
|
warn("$0: bad date_time_spec found \"$_\" after MINUTE\n"),
|
|
return undef
|
|
if $2 eq '';
|
|
}
|
|
else
|
|
{
|
|
warn("$0: bad date_time_spec \"$_\"\n"), return undef
|
|
if defined($last);
|
|
}
|
|
|
|
if (s/^(\d{1,2}(\.\d+)?)//)
|
|
{
|
|
warn("$0: implausible second $1\n"), return undef
|
|
if $1 < 0 || $1 >=60;
|
|
$sec = $1;
|
|
$last = $[;
|
|
last PARSE if $_ eq '';
|
|
warn("$0: bad date_time_spec found \"$_\" after SECOND\n");
|
|
return undef;
|
|
}
|
|
}
|
|
|
|
return $time unless defined($last);
|
|
|
|
$sec = 0 if $last > $[;
|
|
$min = 0 if $last > $[ + 1;
|
|
$hour = 0 if $last > $[ + 2;
|
|
$mday = 1 if $last > $[ + 3;
|
|
$mon = 0 if $last > $[ + 4;
|
|
local($rtime) = &timelocal($sec,$min,$hour,$mday,$mon,$year, 0,0, 0);
|
|
|
|
;# $rtime may be off if daylight savings time is in effect at given date
|
|
return $rtime + ($sec - int($sec))
|
|
if $hour == (localtime($rtime))[$[+2];
|
|
return
|
|
&timelocal($sec,$min,$hour,$mday,$mon,$year, 0,0, 1)
|
|
+ ($sec - int($sec));
|
|
}
|
|
|
|
|
|
sub min
|
|
{
|
|
local($m) = shift;
|
|
|
|
grep((($m > $_) && ($m = $_),0),@_);
|
|
$m;
|
|
}
|
|
|
|
sub max
|
|
{
|
|
local($m) = shift;
|
|
|
|
grep((($m < $_) && ($m = $_),0),@_);
|
|
$m;
|
|
}
|