summaryrefslogtreecommitdiff
path: root/scripts/monitoring/ntploopwatch
diff options
context:
space:
mode:
Diffstat (limited to 'scripts/monitoring/ntploopwatch')
-rw-r--r--scripts/monitoring/ntploopwatch1667
1 files changed, 1667 insertions, 0 deletions
diff --git a/scripts/monitoring/ntploopwatch b/scripts/monitoring/ntploopwatch
new file mode 100644
index 0000000..a94695c
--- /dev/null
+++ b/scripts/monitoring/ntploopwatch
@@ -0,0 +1,1667 @@
+#!/usr/bin/perl -w
+;# --*-perl-*--
+;#
+;# /src/NTP/ntp4-dev/scripts/monitoring/ntploopwatch,v 4.7 2004/11/14 16:11:05 kardel RELEASE_20050508_A
+;#
+;# process loop filter statistics file and either
+;# - show statistics periodically using gnuplot
+;# - or print a single plot
+;#
+;# Copyright (c) 1992-1998
+;# Rainer Pruy, Friedrich-Alexander Universität Erlangen-Nürnberg
+;#
+;#
+;#############################################################
+$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,".");
+
+require "lr.pl"; # linear regresion routines
+
+$MJD_1970 = 40587; # from ntp.h (V3)
+$RecordSize = 48; # usually a line fits into 42 bytes
+$MinClip = 1; # clip Y scales with greater range than this
+
+;# largest extension of Y scale from mean value, factor for standart deviation
+$FuzzLow = 2.2; # for side closer to zero
+$FuzzBig = 1.8; # 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;
+} # ' re-sync emacs fontification
+else
+{
+ @Month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
+ @Day = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
+}
+print @ctime'DoW if 0; # ' re-sync emacs fontification
+
+;# 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) ? -($_[$[]) : $_[$[];
+}
+
+sub boolval
+{
+ local($v) = ($_[$[]);
+
+ return 1 if ($v eq 'yes') || ($v eq 'y');
+ return 1 if ($v =~ /^[0-9]*$/) && ($v != 0);
+ return 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 = boolval($v),1) && next;
+ ($c eq 'showfreq') &&
+ ($showfreq = boolval($v),1) && next;
+ ($c eq 'showcmpl') &&
+ ($showcmpl = boolval($v),1) && next;
+ ($c eq 'showoreg') &&
+ ($showoreg = boolval($v),1) && next;
+ ($c eq 'showfreg') &&
+ ($showfreg = boolval($v),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($$)
+{
+ my($lo, $lf) = @_;
+ 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 = ",");
+ $LastCmplScale = 1 if ! defined($LastCmplScale);
+ $showcmpl &&
+ ($doplot .= sprintf($fmt,$c,$tmpfile,4,
+ "compliance" .
+ (&abs($LastCmplScale) > 1
+ ? " / $LastCmplScale"
+ : (&abs($LastCmplScale) == 1 ? "" : " * ".(1/$LastCmplScale))),
+ $mincmpl/$LastCmplScale,$maxcmpl/$LastCmplScale,
+ ""),
+ $c = ",");
+ $LastFreqBase = 0 if ! defined($LastFreqBase);
+ $LastFreqBaseString = "?" if ! defined($LastFreqBaseString);
+ $FreqScale = 1 if ! defined($FreqScale);
+ $FreqScaleInv = 1 if ! defined($FreqScaleInv);
+ $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,
+ $lo->B(),$lo->A(),
+ "offset ",
+ $lo->B(),
+ (($lo->A()) < 0 ? '-' : '+'),
+ &abs($lo->A()), $lo->r(),
+ "[ms]"),
+ $c = ",");
+ $showfreg && $showfreq &&
+ ($doplot .= sprintf($regfmt, $c,
+ $lf->B() * $FreqScale,
+ ($lf->A() + $minfreq) * $FreqScale - $LastFreqBase,
+ "frequency",
+ $lf->B() * $FreqScale,
+ (($lf->A() + $minfreq) * $FreqScale - $LastFreqBase) < 0 ? '-' : '+',
+ &abs(($lf->A() + $minfreq) * $FreqScale - $LastFreqBase),
+ $lf->r(),
+ "[${FreqScaleInv}ppm]"),
+ $c = ",");
+ $doplot .= "\n";
+}
+
+%F_key = ();
+%F_name = ();
+%F_size = ();
+%F_mtime = ();
+%F_first = ();
+%F_last = ();
+
+sub genfile
+{
+ local($cnt,$in,$out,$lo,$lf,@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;
+
+ $fpos[$[] = '' if !defined($fpos[$[]);
+
+ if (index($in,"/") < $[)
+ {
+ $sdir = ".";
+ $sname = $in;
+ }
+ else
+ {
+ ($sdir,$sname) = ($in =~ m!^(.*)/([^/]*)!);
+ $sname = "" unless defined($sname);
+ }
+
+ $Ltime = -1 if ! defined($Ltime);
+ 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} ne $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 < 6; # no valid input line is this short
+ next if $F[$[] eq "";
+ next if ($F[$[] !~ /^\d+$/);
+ ($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[$[+5]);
+
+ 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;
+
+ if (@time)
+ {
+ local($_,@F);
+
+ local($timebase) unless defined($timebase);
+ local($freqbase) unless defined($freqbase);
+ local($cmplscale) unless defined($cmplscale);
+
+ undef $mintime;
+ undef $maxtime;
+ undef $minoffs;
+ undef $maxoffs;
+ undef $minfreq;
+ undef $maxfreq;
+ undef $mincmpl;
+ undef $maxcmpl;
+ undef $miny;
+ undef $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 = $[;
+ $lo->sample(($time[$i]-$timebase)/3600,$offs[$i]),$i++
+ while $i <= $#time;
+
+ ($minoffs == $maxoffs) && ($minoffs -= 0.1,$maxoffs += 0.1);
+
+ $i = $lo->sigma();
+ $m = $lo->mean();
+
+ 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 = $[;
+ $lf->sample(($time[$i]-$timebase)/3600,$freq[$i]-$minfreq),
+ $i++
+ while $i <= $#time;
+
+ $i = $lf->sigma();
+ $m = $lf->mean() + $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.9999);
+ $FreqScaleInv =
+ ("$FreqScale" =~ /^10(0*)$/) ? "0.${1}1" :
+ ($FreqScale == 1 ? "" : (1/$FreqScale));
+
+ $freqbase = ($maxfreq + $minfreq)/ 2 * $FreqScale; #$m * $FreqScale;
+ $freqbase -= ($maxy + $miny) / 2; #$lf->mean();
+
+ ;# round resulting freqbase
+ ;# to precision of min max difference
+ $s = -12;
+ $s = int(log(($maxfreq-$minfreq)*$FreqScale)/log(10))-1
+ unless ($maxfreq-$minfreq) < 1e-12;
+ $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";
+ $lo->sample(0,1);
+ $lo->sample(1,1);
+ $lf->sample(0,2);
+ $lf->sample(1,2);
+ @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' && scalar(@loffset) >= $cnt) ||
+ ($fpos[$[] eq 'start' && $mintime <= $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 occurred 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;
+ }
+}
+
+$Ltime = -1 if ! defined($Ltime);
+$LastFreqBase = 0;
+$LastFreqBaseString = "??";
+
+;# 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);
+ my $lo = lr->new();
+ my $lf = lr->new();
+
+ @filepos = &genfile($samples,$srcprefix,$tmpfile,$lo,$lf,@filepos);
+
+ ;# make plotcmd display samples
+ make_doplot($lo, $lf);
+ 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;
+}
View Lorry Controller Status