1#!/usr/bin/perl -w
2;# --*-perl-*--
3;#
4;# /src/NTP/ntp4-dev/scripts/monitoring/ntploopwatch,v 4.7 2004/11/14 16:11:05 kardel RELEASE_20050508_A
5;#
6;# process loop filter statistics file and either
7;#     - show statistics periodically using gnuplot
8;#     - or print a single plot
9;#
10;#  Copyright (c) 1992-1998
11;#  Rainer Pruy, Friedrich-Alexander Universit�t Erlangen-N�rnberg
12;#
13;#
14;#############################################################
15$0 =~ s!^.*/([^/]+)$!$1!;
16$F = ' ' x length($0);
17$|=1;
18
19$ENV{'SHELL'} = '/bin/sh'; # use bourne shell
20
21undef($config);
22undef($workdir);
23undef($PrintIt);
24undef($samples);
25undef($StartTime);
26undef($EndTime);
27($a,$b) if 0;                           # keep -w happy
28$usage = <<"E-O-P";
29usage:
30  to watch statistics permanently:
31     $0 [-v[<level>]] [-c <config-file>] [-d <working-dir>]
32     $F [-h <hostname>]
33
34  to get a single print out specify also
35     $F -P[<printer>] [-s<samples>]
36     $F               [-S <start-time>] [-E <end-time>]
37     $F               [-Y <MaxOffs>] [-y <MinOffs>]
38
39If You like long option names, You can use:
40    -help
41    -c    +config
42    -d    +directory
43    -h    +host
44    -v    +verbose[=<level>]
45    -P    +printer[=<printer>]
46    -s    +samples[=<samples>]
47    -S    +starttime
48    -E    +endtime
49    -Y    +maxy
50    -y    +miny
51
52If <printer> contains a '/' (slash character) output is directed to
53a file of this name instead of delivered to a printer.
54E-O-P
55
56;# add directory to look for lr.pl and timelocal.pl (in front of current list)
57unshift(@INC,".");
58
59require "lr.pl";    # linear regresion routines
60
61$MJD_1970 = 40587;            # from ntp.h (V3)
62$RecordSize = 48;             # usually a line fits into 42 bytes
63$MinClip = 1;                 # clip Y scales with greater range than this
64
65;# largest extension of Y scale from mean value, factor for standart deviation
66$FuzzLow = 2.2;                         # for side closer to zero
67$FuzzBig = 1.8;                         # for side farther from zero
68
69require "ctime.pl";
70require "timelocal.pl";
71;# early distributions of ctime.pl had a bug
72$ENV{'TZ'} = 'MET' unless defined $ENV{'TZ'} || $[ > 4.010;
73if (defined(@ctime'MoY))
74{
75  *Month=*ctime'MoY;
76  *Day=*ctime'DoW;
77}                                                 # ' re-sync emacs fontification
78else
79{
80  @Month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
81  @Day   = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
82}
83print @ctime'DoW if 0; # ' re-sync emacs fontification
84
85;# max number of days per month
86@MaxNumDaysPerMonth = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
87
88;# config settable parameters
89$delay = 60;
90$srcprefix = "./var\@\$STATHOST/loopstats.";
91$showoffs = 1;
92$showfreq = 1;
93$showcmpl = 0;
94$showoreg = 0;
95$showfreg = 0;
96undef($timebase);
97undef($freqbase);
98undef($cmplscale);
99undef($MaxY);
100undef($MinY);
101$deltaT  = 512; # indicate sample data gaps greater than $deltaT seconds
102$verbose = 1;
103
104while($_ = shift(@ARGV))
105{
106    (/^[+-]help$/) && die($usage);
107
108    (/^-c$/ || /^\+config$/) &&
109          (@ARGV || die($usage), $config = shift(@ARGV), next);
110
111    (/^-d$/ || /^\+directory$/) &&
112          (@ARGV || die($usage), $workdir = shift(@ARGV), next);
113
114    (/^-h$/ || /^\+host$/) &&
115          (@ARGV || die($usage), $STATHOST = shift, next);
116
117    (/^-v(\d*)$/ || /^\+verbose=?(\d*)$/) &&
118          ($verbose=($1 eq "") ? 1 : $1, next);
119
120    (/^-P(\S*)$/ || /^\+[Pp]rinter=?(\S*)$/) &&
121          ($PrintIt = $1, $verbose==1 && ($verbose = 0), next);
122
123    (/^-s(\d*)$/ || /^\+samples=?(\d*)$/) &&
124          (($samples = ($1 eq "") ? (shift || die($usage)): $1), next);
125
126    (/^-S$/ || /^\+[Ss]tart[Tt]ime$/) &&
127          (@ARGV || die($usage), $StartTime=&date_time_spec2seconds(shift),next);
128
129    (/^-E$/ || /^\+[Ee]nd[Tt]ime$/) &&
130          (@ARGV || die($usage), $EndTime = &date_time_spec2seconds(shift),next);
131
132    (/^-Y$/ || /^\+[Mm]ax[Yy]$/) &&
133          (@ARGV || die($usage), $MaxY = shift, next);
134
135    (/^-y$/ || /^\+[Mm]in[Yy]$/) &&
136          (@ARGV || die($usage), $MinY = shift, next);
137
138    die("$0: unexpected argument \"$_\"\n$usage");
139}
140
141if (defined($workdir))
142{
143  chdir($workdir) ||
144      die("$0: failed to change working dir to \"$workdir\": $!\n");
145}
146
147$PrintIt = "ps" if defined($PrintIt) && $PrintIt eq "";
148
149if (!defined($PrintIt))
150{
151    defined($samples) &&
152          print "WARNING: your samples value may be shadowed by config file settings\n";
153    defined($StartTime) &&
154          print "WARNING: your StartTime value may be shadowed by config file settings\n";
155    defined($EndTime) &&
156          print "WARNING: your EndTime value may be shadowed by config file settings\n";
157    defined($MaxY) &&
158          print "WARNING: your MaxY value may be shadowed by config file settings\n";
159    defined($MinY) &&
160          print "WARNING: your MinY value may be shadowed by config file settings\n";
161
162    ;# check operating environment
163    ;#
164    ;# gnuplot usually has X support
165    ;# I vaguely remember there was one with sunview support
166    ;#
167    ;# If Your plotcmd can display graphics using some other method
168    ;# (Tek window,..) fix the following test
169    ;# (or may be, just disable it)
170    ;#
171    !(defined($ENV{'DISPLAY'}) || defined($ENV{'WINDOW_PARENT'})) &&
172          die("Need window system to monitor statistics\n");
173}
174
175;# configuration file
176$config = "loopwatch.config" unless defined($config);
177($STATHOST = $config) =~ s!.*loopwatch\.config.([^/\.]*)$!$1!
178    unless defined($STATHOST);
179($STATTAG = $STATHOST) =~ s/^([^\.\*\s]+)\..*$/$1/;
180
181$srcprefix =~ s/\$STATHOST/$STATHOST/g;
182
183;# plot command
184@plotcmd=("gnuplot",
185            '-title', "Ntp loop filter statistics $STATHOST",
186            '-name', "NtpLoopWatch_$STATTAG");
187$tmpfile = "/tmp/ntpstat.$$";
188
189;# other variables
190$doplot = "";       # assembled command for @plotcmd to display plot
191undef($laststat);
192
193;# plot value ranges
194undef($mintime);
195undef($maxtime);
196undef($minoffs);
197undef($maxoffs);
198undef($minfreq);
199undef($maxfreq);
200undef($mincmpl);
201undef($maxcmpl);
202undef($miny);
203undef($maxy);
204
205;# stop operation if plot command dies
206sub sigchld
207{
208  local($pid) = wait;
209  unlink($tmpfile);
210  warn(sprintf("%s: %s died: exit status: %d signal %d\n",
211                $0,
212                 (defined($Plotpid) && $Plotpid == $pid)
213                 ? "plotcmd" : "unknown child $pid",
214                 $?>>8,$? & 0xff)) if $?;
215  exit(1) if $? && defined($Plotpid) && $pid == $Plotpid;
216}
217&sigchld if 0;
218$SIG{'CHLD'} = "sigchld";
219$SIG{'CLD'} = "sigchld";
220
221sub abort
222{
223  unlink($tmpfile);
224  defined($Plotpid) && kill('TERM',$Plotpid);
225  die("$0: received signal SIG$_[$[] - exiting\n");
226}
227&abort if 0;        # make -w happy - &abort IS used
228$SIG{'INT'} = $SIG{'HUP'} = $SIG{'QUIT'} = $SIG{'TERM'} = $SIG{'PIPE'} = "abort";
229
230;#
231sub abs
232{
233  ($_[$[] < 0) ? -($_[$[]) : $_[$[];
234}
235
236sub boolval
237{
238  local($v) = ($_[$[]);
239
240  return 1 if ($v eq 'yes') || ($v eq 'y');
241  return 1 if ($v =~ /^[0-9]*$/) && ($v != 0);
242  return 0;
243}
244
245;#####################
246;# start of real work
247
248print "starting plot command (" . join(" ",@plotcmd) . ")\n" if $verbose > 1;
249
250$Plotpid = open(PLOT,"|-");
251select((select(PLOT),$|=1)[$[]);        # make PLOT line bufferd
252
253defined($Plotpid) ||
254    die("$0: failed to start plot command: $!\n");
255
256unless ($Plotpid)
257{
258   ;# child == plot command
259   close(STDOUT);
260   open(STDOUT,">&STDERR") ||
261       die("$0: failed to redirect STDOUT of plot command: $!\n");
262
263   print STDOUT "plot command running as $$\n";
264
265   exec @plotcmd;
266   die("$0: failed to exec (@plotcmd): $!\n");
267   exit(1); # in case ...
268}
269
270sub read_config
271{
272  local($at) = (stat($config))[$[+9];
273  local($_,$c,$v);
274
275  (undef($laststat),(print("stat $config failed: $!\n")),return) if ! defined($at);
276  return if (defined($laststat) && ($laststat == $at));
277  $laststat = $at;
278
279  print "reading configuration from \"$config\"\n" if $verbose;
280
281  open(CF,"<$config") ||
282      (warn("$0: failed to read \"$config\" - using old settings ($!)\n"),
283       return);
284  while(<CF>)
285  {
286    chop;
287    s/^([^\#]*[^\#\s]?)\s*\#.*$//;
288    next if /^\s*$/;
289
290    s/^\s*([^=\s]*)\s*=\s*(.*\S)\s*$/$1=$2/;
291
292    ($c,$v) = split(/=/,$_,2);
293    print "processing \"$c=$v\"\n" if $verbose > 3;
294    ($c eq "delay") && ($delay = $v,1) && next;
295    ($c eq 'samples') && (!defined($PrintIt) || !defined($samples)) &&
296          ($samples = $v,1) && next;
297    ($c eq 'srcprefix') && (($srcprefix=$v)=~s/\$STATHOST/$STATHOST/g,1)
298          && next;
299    ($c eq 'showoffs') &&
300          ($showoffs = boolval($v),1) && next;
301    ($c eq 'showfreq') &&
302          ($showfreq = boolval($v),1) && next;
303    ($c eq 'showcmpl') &&
304          ($showcmpl = boolval($v),1) && next;
305    ($c eq 'showoreg') &&
306          ($showoreg = boolval($v),1) && next;
307    ($c eq 'showfreg') &&
308          ($showfreg = boolval($v),1) && next;
309
310    ($c eq 'exit') && (unlink($tmpfile),die("$0: exit by config request\n"));
311
312    ($c eq 'freqbase' ||
313     $c eq 'cmplscale') &&
314          do {
315              if (! defined($v) || $v eq "" || $v eq 'dynamic')
316              {
317                eval "undef(\$$c);";
318              }
319              else
320              {
321                eval "\$$c = \$v;";
322              }
323              next;
324          };
325    ($c eq 'timebase') &&
326          do {
327              if (! defined($v) || $v eq "" || $v eq "dynamic")
328              {
329                undef($timebase);
330              }
331              else
332              {
333                $timebase=&date_time_spec2seconds($v);
334              }
335          };
336    ($c eq 'EndTime') &&
337          do {
338              next if defined($EndTime) && defined($PrintIt);
339              if (! defined($v) || $v eq "" || $v eq "none")
340              {
341                undef($EndTime);
342              }
343              else
344              {
345                $EndTime=&date_time_spec2seconds($v);
346              }
347          };
348    ($c eq 'StartTime') &&
349          do {
350              next if defined($StartTime) && defined($PrintIt);
351              if (! defined($v) || $v eq "" || $v eq "none")
352              {
353                undef($StartTime);
354              }
355              else
356              {
357                $StartTime=&date_time_spec2seconds($v);
358              }
359          };
360
361    ($c eq 'MaxY') &&
362          do {
363              next if defined($MaxY) && defined($PrintIt);
364              if (! defined($v) || $v eq "" || $v eq "none")
365              {
366                undef($MaxY);
367              }
368              else
369              {
370                $MaxY=$v;
371              }
372          };
373
374    ($c eq 'MinY') &&
375          do {
376              next if defined($MinY) && defined($PrintIt);
377              if (! defined($v) || $v eq "" || $v eq "none")
378              {
379                undef($MinY);
380              }
381              else
382              {
383                $MinY=$v;
384              }
385          };
386
387    ($c eq 'deltaT') &&
388          do {
389              if (!defined($v) || $v eq "")
390              {
391                undef($deltaT);
392              }
393              else
394              {
395                $deltaT = $v;
396              }
397              next;
398          };
399    ($c eq 'verbose') && ! defined($PrintIt) &&
400          do {
401               if (!defined($v) || $v == 0)
402               {
403                 $verbose = 0;
404               }
405               else
406               {
407                 $verbose = $v;
408               }
409               next;
410          };
411    ;# otherwise: silently ignore unrecognized config line
412  }
413  close(CF);
414  ;# set show defaults when nothing selected
415  $showoffs = $showfreq = $showcmpl = 1
416      unless $showoffs || $showfreq || $showcmpl;
417  if ($verbose > 3)
418  {
419    print  "new configuration:\n";
420    print  "   delay\t= $delay\n";
421    print  "   samples\t= $samples\n";
422    print  "   srcprefix\t= $srcprefix\n";
423    print  "   showoffs\t= $showoffs\n";
424    print  "   showfreq\t= $showfreq\n";
425    print  "   showcmpl\t= $showcmpl\n";
426    print  "   showoreg\t= $showoreg\n";
427    print  "   showfreg\t= $showfreg\n";
428    printf "   timebase\t= %s",defined($timebase)?&ctime($timebase):"dynamic\n";
429    printf "   freqbase\t= %s\n",defined($freqbase)  ?"$freqbase":"dynamic";
430    printf "   cmplscale\t= %s\n",defined($cmplscale)?"$cmplscale":"dynamic";
431    printf "   StartTime\t= %s",defined($StartTime)?&ctime($StartTime):"none\n";
432    printf "   EndTime\t= %s",  defined($EndTime) ?  &ctime($EndTime):"none\n";
433    printf "   MaxY\t= %s",defined($MaxY)? $MaxY      :"none\n";
434    printf "   MinY\t= %s",defined($MinY)? $MinY      :"none\n";
435    print  "   verbose\t= $verbose\n";
436  }
437print "configuration file read\n" if $verbose > 2;
438}
439
440sub make_doplot($$)
441{
442    my($lo, $lf) = @_;
443    local($c) = ("");
444    local($fmt)
445          = ("%s \"%s\" using 1:%d title '%s <%lf %lf> %6s' with lines");
446    local($regfmt)
447          = ("%s ((%lf * x) + %lf) title 'lin. approx. %s (%f t[h]) %s %f <%f> %6s' with lines");
448
449    $doplot = "    set title 'NTP loopfilter statistics for $STATHOST  " .
450          "(last $LastCnt samples from $srcprefix*)'\n";
451
452    local($xts,$xte,$i,$t);
453
454    local($s,$c) = ("");
455
456    ;# number of integral seconds to get at least 12 tic marks on x axis
457    $t = int(($maxtime - $mintime) / 12 + 0.5);
458    $t = 1 unless $t;                   # prevent $t to be zero
459    foreach $i (30,
460                    60,5*60,15*60,30*60,
461                    60*60,2*60*60,6*60*60,12*60*60,
462                    24*60*60,48*60*60)
463    {
464          last if $t < $i;
465          $t = $t - ($t % $i);
466    }
467    print "time label resolution: $t seconds\n" if $verbose > 1;
468
469    ;# make gnuplot use wall clock time labels instead of NTP seconds
470    for ($c="", $i = $mintime - ($mintime % $t);
471           $i <= $maxtime + $t;
472           $i += $t, $c=",")
473    {
474          $s .= $c;
475          ((int($i / $t) % 2) &&
476           ($s .= sprintf("'' %lf",($i - $LastTimeBase)/3600))) ||
477               (($t <= 60) &&
478                ($s .= sprintf("'%d:%02d:%02d' %lf",
479                                   (localtime($i))[$[+2,$[+1,$[+0],
480                                   ($i - $LastTimeBase)/3600)))
481                     || (($t <= 2*60*60) &&
482                         ($s .= sprintf("'%d:%02d' %lf",
483                                            (localtime($i))[$[+2,$[+1],
484                                            ($i - $LastTimeBase)/3600)))
485                         || (($t <= 12*60*60) &&
486                               ($s .= sprintf("'%s %d:00' %lf",
487                                                  $Day[(localtime($i))[$[+6]],
488                                                  (localtime($i))[$[+2],
489                                                  ($i - $LastTimeBase)/3600)))
490                               || ($s .= sprintf("'%d.%d-%d:00' %lf",
491                                                     (localtime($i))[$[+3,$[+4,$[+2],
492                                                     ($i - $LastTimeBase)/3600));
493    }
494    $doplot .= "set xtics ($s)\n";
495
496    chop($xts = &ctime($mintime));
497    chop($xte = &ctime($maxtime));
498    $doplot .= "set xlabel 'Start:  $xts    --   Time Scale   --    End:  $xte'\n";
499    $doplot .= "set yrange [" ;
500    $doplot .= defined($MinY) ? sprintf("%lf", $MinY) : $miny;
501    $doplot .= ':';
502    $doplot .= defined($MaxY) ? sprintf("%lf", $MaxY) : $maxy;
503    $doplot .= "]\n";
504
505    $doplot .= "   plot";
506    $c = "";
507    $showoffs &&
508          ($doplot .= sprintf($fmt,$c,$tmpfile,2,
509                                  "offset",
510                                  $minoffs,$maxoffs,
511                                  "[ms]"),
512           $c = ",");
513    $LastCmplScale = 1 if ! defined($LastCmplScale);
514    $showcmpl &&
515          ($doplot .= sprintf($fmt,$c,$tmpfile,4,
516                                  "compliance" .
517                                  (&abs($LastCmplScale) > 1
518                                   ? " / $LastCmplScale"
519                                   : (&abs($LastCmplScale) == 1 ? "" : " * ".(1/$LastCmplScale))),
520                                  $mincmpl/$LastCmplScale,$maxcmpl/$LastCmplScale,
521                                  ""),
522           $c = ",");
523    $LastFreqBase = 0 if ! defined($LastFreqBase);
524    $LastFreqBaseString = "?" if ! defined($LastFreqBaseString);
525    $FreqScale = 1 if ! defined($FreqScale);
526    $FreqScaleInv = 1 if ! defined($FreqScaleInv);
527    $showfreq &&
528          ($doplot .= sprintf($fmt,$c,$tmpfile,3,
529                                  "frequency" .
530                                  ($LastFreqBase > 0
531                                   ? " - $LastFreqBaseString"
532                                   : ($LastFreqBase == 0 ? "" : " + $LastFreqBaseString")),
533                                  $minfreq * $FreqScale - $LastFreqBase,
534                                  $maxfreq * $FreqScale - $LastFreqBase,
535                                  "[${FreqScaleInv}ppm]"),
536           $c = ",");
537    $showoreg && $showoffs &&
538          ($doplot .= sprintf($regfmt, $c,
539                                  $lo->B(),$lo->A(),
540                                  "offset   ",
541                                  $lo->B(),
542                                  (($lo->A()) < 0 ? '-' : '+'),
543                                  &abs($lo->A()), $lo->r(),
544                                  "[ms]"),
545           $c = ",");
546    $showfreg && $showfreq &&
547          ($doplot .= sprintf($regfmt, $c,
548                                  $lf->B() * $FreqScale,
549                                  ($lf->A() + $minfreq) * $FreqScale - $LastFreqBase,
550                                  "frequency",
551                                  $lf->B() * $FreqScale,
552                                  (($lf->A() + $minfreq) * $FreqScale - $LastFreqBase) < 0 ? '-' : '+',
553                                  &abs(($lf->A() + $minfreq) * $FreqScale - $LastFreqBase),
554                                  $lf->r(),
555                                  "[${FreqScaleInv}ppm]"),
556           $c = ",");
557    $doplot .= "\n";
558}
559
560%F_key   = ();
561%F_name  = ();
562%F_size  = ();
563%F_mtime = ();
564%F_first = ();
565%F_last  = ();
566
567sub genfile
568{
569    local($cnt,$in,$out,$lo,$lf,@fpos) = @_;
570
571    local(@F,@t,$t,$lastT) = ();
572    local(@break,@time,@offs,@freq,@cmpl,@loffset,@filekey) = ();
573    local($lm,$l,@f);
574
575    local($sdir,$sname);
576
577    ;# allocate some storage for the tables
578    ;# otherwise realloc may get into troubles
579    if (defined($StartTime) && defined($EndTime))
580    {
581          $l = ($EndTime-$StartTime) -$[+1 +1; # worst case: 1 sample per second
582    }
583    else
584    {
585          $l = $cnt + 10;
586    }
587    print "preextending arrays to $l entries\n" if $verbose > 2;
588    $#break =   $l; for ($i=$[; $i<=$l;$i++) { $break[$i] = 0; }
589    $#time =    $l; for ($i=$[; $i<=$l;$i++) { $time[$i] = 0; }
590    $#offs =    $l; for ($i=$[; $i<=$l;$i++) { $offs[$i] = 0; }
591    $#freq =    $l; for ($i=$[; $i<=$l;$i++) { $freq[$i] = 0; }
592    $#cmpl =    $l; for ($i=$[; $i<=$l;$i++) { $cmpl[$i] = 0; }
593    $#loffset = $l; for ($i=$[; $i<=$l;$i++) { $loffset[$i] = 0; }
594    $#filekey = $l; for ($i=$[; $i<=$l;$i++) { $filekey[$i] = 0; }
595    ;# now reduce size again
596    $#break =   $[ - 1;
597    $#time =    $[ - 1;
598    $#offs =    $[ - 1;
599    $#freq =    $[ - 1;
600    $#cmpl =    $[ - 1;
601    $#loffset = $[ - 1;
602    $#filekey = $[ - 1;
603    print "memory allocation ready\n" if $verbose > 2;
604    sleep(3) if $verbose > 1;
605
606    $fpos[$[] = '' if !defined($fpos[$[]);
607
608    if (index($in,"/") < $[)
609    {
610          $sdir = ".";
611          $sname = $in;
612    }
613    else
614    {
615          ($sdir,$sname) = ($in =~ m!^(.*)/([^/]*)!);
616          $sname = "" unless defined($sname);
617    }
618
619    $Ltime = -1 if ! defined($Ltime);
620    if (!defined($Lsdir) || $Lsdir ne $sdir || $Ltime != (stat($sdir))[$[+9] ||
621          grep($F_mtime{$_} != (stat($F_name{$_}))[$[+9], @F_files))
622
623    {
624          print "rescanning directory \"$sdir\" for files \"$sname*\"\n"
625              if $verbose > 1;
626
627          ;# rescan directory on changes
628          $Lsdir = $sdir;
629          $Ltime = (stat($sdir))[$[+9];
630          </X{> if 0;                   # dummy line - calm down my formatter
631          local(@newfiles) = < ${in}*[0-9] >;
632          local($st_dev,$st_ino,$st_mtime,$st_size,$name,$key,$modified);
633
634          foreach $name (@newfiles)
635          {
636              ($st_dev,$st_ino,$st_size,$st_mtime) =
637                    (stat($name))[$[,$[+1,$[+7,$[+9];
638              $modified = 0;
639              $key = sprintf("%lx|%lu", $st_dev, $st_ino);
640
641              print "candidate file \"$name\"",
642                  (defined($st_dev) ? "" : " failed: $!"),"\n"
643                          if $verbose > 2;
644
645              if (! defined($F_key{$name}) || $F_key{$name} ne $key)
646              {
647                    $F_key{$name} = $key;
648                    $modified++;
649              }
650              if (!defined($F_name{$key}) || $F_name{$key} ne $name)
651              {
652                    $F_name{$key} = $name;
653                    $modified++;
654              }
655              if (!defined($F_size{$key}) || $F_size{$key} != $st_size)
656              {
657                    $F_size{$key} = $st_size;
658                    $modified++;
659              }
660              if (!defined($F_mtime{$key}) || $F_mtime{$key} != $st_mtime)
661              {
662                    $F_mtime{$key} = $st_mtime;
663                    $modified++;
664              }
665              if ($modified)
666              {
667                    print "new data \"$name\" key: $key;\n" if $verbose > 1;
668                  print "             size: $st_size; mtime: $st_mtime;\n"
669                        if $verbose > 1;
670                    $F_last{$key} = $F_first{$key} = $st_mtime;
671                    $F_first{$key}--; # prevent zero divide later on
672                    ;# now compute derivated attributes
673                    open(IN, "<$name") ||
674                        do {
675                              warn "$0: failed to open \"$name\": $!";
676                              next;
677                        };
678
679                    while(<IN>)
680                    {
681                        @F = split;
682                        next if @F < 5;
683                        next if $F[$[] eq "";
684                        $t = ($F[$[] - $MJD_1970) * 24 * 60 * 60;
685                        $t += $F[$[+1];
686                        $F_first{$key} = $t;
687                        print "\tfound first entry: $t ",&ctime($t)
688                              if $verbose > 4;
689                        last;
690                    }
691                    seek(IN,
692                         ($st_size > 4*$RecordSize) ? $st_size - 4*$RecordSize : 0,
693                         0);
694                    while(<IN>)
695                    {
696                        @F = split;
697                        next if @F < 5;
698                        next if $F[$[] eq "";
699                        $t = ($F[$[] - $MJD_1970) * 24 * 60 * 60;
700                        $t += $F[$[+1];
701                        $F_last{$key} = $t;
702                        $_ = <IN>;
703                        print "\tfound last entry: $t ", &ctime($t)
704                              if $verbose > 4 && ! defined($_);
705                        last unless defined($_);
706                        redo;
707                        ;# Ok, calm down...
708                        ;# using $_ = <IN> in conjunction with redo
709                        ;# is semantically equivalent to the while loop, but
710                        ;# I needed a one line look ahead and this solution
711                        ;# was what I thought of first
712                        ;# and.. If you do not like it dont look
713                    }
714                    close(IN);
715                    print("             first: ",$F_first{$key},
716                          " last: ",$F_last{$key},"\n") if $verbose > 1;
717              }
718          }
719          ;# now reclaim memory used for files no longer referenced ...
720          local(%Names);
721          grep(Names{_} = 1,@newfiles);
722          foreach (keys %F_key)
723          {
724              next if defined(Names{_});
725              delete $F_key{$_};
726              $verbose > 2 && print "no longer referenced: \"$_\"\n";
727          }
728          %Names = ();
729
730          grep(Names{_} = 1,values(%F_key));
731          foreach (keys %F_name)
732          {
733              next if defined(Names{_});
734              delete $F_name{$_};
735              $verbose > 2 && print "unref name($_)= $F_name{$_}\n";
736          }
737          foreach (keys %F_size)
738          {
739              next if defined(Names{_});
740              delete $F_size{$_};
741              $verbose > 2 && print "unref size($_)\n";
742          }
743          foreach (keys %F_mtime)
744          {
745              next if defined(Names{_});
746              delete $F_mtime{$_};
747              $verbose > 2 && print "unref mtime($_)\n";
748          }
749          foreach (keys %F_first)
750          {
751              next if defined(Names{_});
752              delete $F_first{$_};
753              $verbose > 2 && print "unref first($_)\n";
754          }
755          foreach (keys %F_last)
756          {
757              next if defined(Names{_});
758              delete $F_last{$_};
759              $verbose > 2 && print "unref last($_)\n";
760          }
761          ;# create list sorted by time
762          @F_files = sort {$F_first{$a} <=> $F_first{$b}; } keys(%F_name);
763          if ($verbose > 1)
764          {
765              print "Resulting file list:\n";
766              foreach (@F_files)
767              {
768                    print "\t$_\t$F_name{$_}\n";
769              }
770          }
771    }
772
773    printf("processing %s; output \"$out\" (%d input files)\n",
774             ((defined($StartTime) && defined($EndTime))
775              ? "time range"
776              : (defined($StartTime) ? "$cnt samples from StartTime" :
777                (defined($EndTime) ? "$cnt samples to EndTime" :
778                     "last $cnt samples"))),
779              scalar(@F_files))
780          if $verbose > 1;
781
782    ;# open output file - will be input for plotcmd
783    open(OUT,">$out") ||
784          do {
785              warn("$0: cannot create \"$out\": $!\n");
786          };
787
788    @f = @F_files;
789    if (defined($StartTime))
790    {
791          while (@f && ($F_last{$f[$[]} < $StartTime))
792          {
793              print("shifting ", $F_name{$f[$[]},
794                      " last: ", $F_last{$f[$[]},
795                      " < StartTime: $StartTime\n")
796                    if $verbose > 3;
797              shift(@f);
798          }
799
800
801    }
802    if (defined($EndTime))
803    {
804          while (@f && ($F_first{$f[$#f]} > $EndTime))
805          {
806              print("popping  ", $F_name{$f[$#f]},
807                      " first: ", $F_first{$f[$#f]},
808                      " > EndTime: $EndTime\n")
809                    if $verbose > 3;
810              pop(@f);
811          }
812    }
813
814    if (@f)
815    {
816          if (defined($StartTime))
817          {
818              print "guess start according to StartTime ($StartTime)\n"
819                    if $verbose > 3;
820
821              if ($fpos[$[] eq 'start')
822              {
823                    if (grep($_ eq $fpos[$[+1],@f))
824                    {
825                        shift(@f) while @f && $f[$[] ne $fpos[$[+1];
826                    }
827                    else
828                    {
829                        @fpos = ('start', $f[$[], undef);
830                    }
831              }
832              else
833              {
834                    @fpos = ('start' , $f[$[], undef);
835              }
836
837              if (!defined($fpos[$[+2]))
838              {
839                    if ($StartTime <= $F_first{$f[$[]})
840                    {
841                        $fpos[$[+2] = 0;
842                    }
843                    else
844                    {
845                        $fpos[$[+2] =
846                              int($F_size{$f[$[]} *
847                                  (($StartTime - $F_first{$f[$[]})/
848                                   ($F_last{$f[$[]} - $F_first{$f[$[]})));
849                        $fpos[$[+2] = ($fpos[$[+2] <= 2 * $RecordSize)
850                              ? 0 : $fpos[$[+2] - 2 * $RecordSize;
851                        ;# anyway  as the data may contain "time holes"
852                        ;# our heuristics may baldly fail
853                        ;# so just start at 0
854                        $fpos[$[+2] = 0;
855                    }
856              }
857          }
858          elsif (defined($EndTime))
859          {
860              print "guess starting point according to EndTime ($EndTime)\n"
861                    if $verbose > 3;
862
863              if ($fpos[$[] eq 'end')
864              {
865                    if (grep($_ eq $fpos[$[+1],@f))
866                    {
867                        shift(@f) while @f && $f[$[] ne $fpos[$[+1];
868                    }
869                    else
870                    {
871                        @fpos = ('end', $f[$[], undef);
872                    }
873              }
874              else
875              {
876                    @fpos = ('end', $f[$[], undef);
877              }
878
879              if (!defined($fpos[$[+2]))
880              {
881                    local(@x) = reverse(@f);
882                    local($s,$c) = (0,$cnt);
883                    if ($EndTime < $F_last{$x[$[]})
884                    {
885                        ;# last file will only be used partially
886                        $s = int($F_size{$x[$[]} *
887                                   (($EndTime - $F_first{$x[$[]}) /
888                                    ($F_last{$x[$[]} - $F_first{$x[$[]})));
889                        $s = int($s/$RecordSize);
890                        $c -= $s - 1;
891                        if ($c <= 0)
892                        {
893                              ;# start is in the same file
894                              $fpos[$[+1] = $x[$[];
895                              $fpos[$[+2] = ($c >=-2) ? 0 : (-$c - 2) * $RecordSize;
896                              shift(@f) while @f && ($f[$[] ne $x[$[]);
897                        }
898                        else
899                        {
900                              shift(@x);
901                        }
902                    }
903
904                    if (!defined($fpos[$[+2]))
905                    {
906                        local($_);
907                        while($_ = shift(@x))
908                        {
909                              $s = int($F_size{$_}/$RecordSize);
910                              $c -= $s - 1;
911                              if ($c <= 0)
912                              {
913                                  $fpos[$[+1] = $_;
914                                  $fpos[$[+2] = ($c>-2) ? 0 : (-$c - 2) * $RecordSize;
915                                  shift(@f) while @f && ($f[$[] ne $_);
916                                  last;
917                              }
918                        }
919                    }
920              }
921          }
922          else
923          {
924              print "guessing starting point according to count ($cnt)\n"
925                    if $verbose > 3;
926              ;# guess offset to get last available $cnt samples
927              if ($fpos[$[] eq 'cnt')
928              {
929                    if (grep($_ eq $fpos[$[+1],@f))
930                    {
931                        print "old positioning applies\n" if $verbose > 3;
932                        shift(@f) while @f && $f[$[] ne $fpos[$[+1];
933                    }
934                    else
935                    {
936                        @fpos = ('cnt', $f[$[], undef);
937                    }
938              }
939              else
940              {
941                    @fpos = ('cnt', $f[$[], undef);
942              }
943
944              if (!defined($fpos[$[+2]))
945              {
946                    local(@x) = reverse(@f);
947                    local($s,$c) = (0,$cnt);
948
949                    local($_);
950                    while($_ = shift(@x))
951                    {
952                        print "examing \"$_\" $c samples still needed\n"
953                              if $verbose > 4;
954                        $s = int($F_size{$_}/$RecordSize);
955                        $c -= $s - 1;
956                        if ($c <= 0)
957                        {
958                              $fpos[$[+1] = $_;
959                              $fpos[$[+2] = ($c>-2) ? 0 : (-$c - 2) * $RecordSize;
960                              shift(@f) while @f && ($f[$[] ne $_);
961                              last;
962                        }
963                    }
964                    if (!defined($fpos[$[+2]))
965                    {
966                        print "no starting point yet - using start of data\n"
967                              if $verbose > 2;
968                        $fpos[$[+2] = 0;
969                    }
970              }
971          }
972    }
973    print "Ooops, no suitable input file ??\n"
974          if $verbose > 1 && @f <= 0;
975
976    printf("Starting at (%s) \"%s\" offset %ld using %d files\n",
977             $fpos[$[+1],
978             $F_name{$fpos[$[+1]},
979             $fpos[$[+2],
980             scalar(@f))
981          if $verbose > 2;
982
983    $lm = 1;
984    $l = 0;
985    foreach $key (@f)
986    {
987          $file = $F_name{$key};
988          print "processing file \"$file\"\n" if $verbose > 2;
989
990          open(IN,"<$file") ||
991              (warn("$0: cannot read \"$file\": $!\n"), next);
992
993          ;# try to seek to a position nearer to the start of the interesting lines
994          ;# should always affect only first item in @f
995          ($key eq $fpos[$[+1]) &&
996              (($verbose > 1) &&
997               print("Seeking to offset $fpos[$[+2]\n"),
998                    seek(IN,$fpos[$[+2],0) ||
999                        warn("$0: seek(\"$F_name{$key}\" failed: $|\n"));
1000
1001          while(<IN>)
1002          {
1003              $l++;
1004              ($verbose > 3) &&
1005                    (($l % $lm) == 0 && print("\t$l lines read\n") &&
1006                     (($l ==     2) && ($lm =    10) ||
1007                      ($l ==   100) && ($lm =   100) ||
1008                      ($l ==   500) && ($lm =   500) ||
1009                      ($l ==  1000) && ($lm =  1000) ||
1010                      ($l ==  5000) && ($lm =  5000) ||
1011                      ($l == 10000) && ($lm = 10000)));
1012
1013              @F = split;
1014
1015              next if @F < 6; # no valid input line is this short
1016              next if $F[$[] eq "";
1017              next if ($F[$[] !~ /^\d+$/);
1018              ($F[$[] !~ /^\d+$/) && # A 'never should have happend' error
1019                    die("$0: unexpected input line: >$_<\n");
1020
1021              ;# modified Julian to UNIX epoch
1022              $t = ($F[$[] - $MJD_1970) * 24 * 60 * 60;
1023              $t += $F[$[+1]; # add seconds + fraction
1024
1025              ;# multiply offset by 1000 to get ms - try to avoid float op
1026              (($F[$[+2] =~ s/(\d*)\.(\d{3})(\d*)/$1$2.$3/) &&
1027               $F[$[+2] =~ s/0+([\d\.])/($1 eq '.') ? '0.' : $1/e) # strip leading zeros
1028                    || ($F[$[+2] *= 1000);
1029
1030
1031              ;# skip samples out of specified time range
1032              next if (defined($StartTime) && $StartTime > $t);
1033              next if (defined($EndTime) && $EndTime < $t);
1034
1035              next if defined($lastT) && $t < $lastT; # backward in time ??
1036
1037              push(@offs,$F[$[+2]);
1038              push(@freq,$F[$[+3] * (2**20/10**6));
1039              push(@cmpl,$F[$[+5]);
1040
1041              push(@break, (defined($lastT) && ($t - $lastT > $deltaT)));
1042              $lastT = $t;
1043              push(@time,$t);
1044              push(@loffset, tell(IN) - length($_));
1045              push(@filekey, $key);
1046
1047              shift(@break),shift(@time),shift(@offs),
1048              shift(@freq), shift(@cmpl),shift(@loffset),
1049              shift(@filekey)
1050                    if @time > $cnt &&
1051                        ! (defined($StartTime) && defined($EndTime));
1052
1053              last if @time >= $cnt && defined($StartTime) && !defined($EndTime);
1054          }
1055          close(IN);
1056          last if @time >= $cnt && defined($StartTime) && !defined($EndTime);
1057    }
1058    print "input scanned ($l lines/",scalar(@time)," samples)\n"
1059          if $verbose > 1;
1060
1061    if (@time)
1062    {
1063          local($_,@F);
1064
1065          local($timebase) unless defined($timebase);
1066          local($freqbase) unless defined($freqbase);
1067          local($cmplscale) unless defined($cmplscale);
1068
1069          undef $mintime;
1070          undef $maxtime;
1071          undef $minoffs;
1072          undef $maxoffs;
1073          undef $minfreq;
1074          undef $maxfreq;
1075          undef $mincmpl;
1076          undef $maxcmpl;
1077          undef $miny;
1078          undef $maxy ;
1079
1080          print "computing ranges\n" if $verbose > 2;
1081
1082          $LastCnt = @time;
1083
1084          ;# @time is in ascending order (;-)
1085          $mintime = $time[$[];
1086          $maxtime = $time[$#time];
1087          unless (defined($timebase))
1088          {
1089              local($time,@X) = (time);
1090              @X = localtime($time);
1091
1092              ;# compute today 00:00:00
1093              $timebase = $time - ((($X[$[+2]*60)+$X[$[+1])*60+$X[$[]);
1094
1095          }
1096          $LastTimeBase = $timebase;
1097
1098          if ($showoffs)
1099          {
1100              local($i,$m,$f);
1101
1102              $minoffs = &min(@offs);
1103              $maxoffs = &max(@offs);
1104
1105              ;# I know, it is not perl style using indices to access arrays,
1106              ;# but I have to proccess two arrays in sync, non-destructively
1107              ;# (otherwise a (shift(@a1),shift(a2)) would do),
1108              ;# I dont like to make copies of these arrays as they may be huge
1109              $i = $[;
1110              $lo->sample(($time[$i]-$timebase)/3600,$offs[$i]),$i++
1111                    while $i <= $#time;
1112
1113              ($minoffs == $maxoffs) && ($minoffs -= 0.1,$maxoffs += 0.1);
1114
1115              $i = $lo->sigma();
1116              $m = $lo->mean();
1117
1118              print "mean offset: $m sigma: $i\n" if $verbose > 2;
1119
1120              if (($maxoffs - $minoffs) > $MinClip)
1121              {
1122                    $f = (&abs($minoffs) < &abs($maxoffs)) ? $FuzzLow : $FuzzBig;
1123                    $miny = (($m - $minoffs) <= ($f * $i))
1124                        ? $minoffs : ($m - $f * $i);
1125                    $f = ($f == $FuzzLow) ? $FuzzBig : $FuzzLow;
1126                    $maxy = (($maxoffs - $m) <= ($f * $i))
1127                        ? $maxoffs : ($m + $f * $i);
1128              }
1129              else
1130              {
1131                    $miny = $minoffs;
1132                    $maxy = $maxoffs;
1133              }
1134              ($maxy-$miny) == 0 &&
1135                    (($maxy,$miny)
1136                     = (($maxoffs - $minoffs) > 0)
1137                     ? ($maxoffs,$minoffs) : ($MinClip,-$MinClip));
1138
1139              $maxy = $MaxY if defined($MaxY) && $MaxY < $maxy;
1140              $miny = $MinY if defined($MinY) && $MinY > $miny;
1141
1142              print  "offset min clipped from $minoffs to $miny\n"
1143                    if $verbose > 2 && $minoffs != $miny;
1144              print  "offset max clipped from $maxoffs to $maxy\n"
1145                    if $verbose > 2 && $maxoffs != $maxy;
1146          }
1147
1148          if ($showfreq)
1149          {
1150              local($i,$m);
1151
1152              $minfreq = &min(@freq);
1153              $maxfreq = &max(@freq);
1154
1155              $i = $[;
1156              $lf->sample(($time[$i]-$timebase)/3600,$freq[$i]-$minfreq),
1157              $i++
1158                    while $i <= $#time;
1159
1160              $i = $lf->sigma();
1161              $m = $lf->mean() + $minfreq;
1162
1163              print "mean frequency: $m sigma: $i\n" if $verbose > 2;
1164
1165              if (defined($maxy))
1166              {
1167                    local($s) =
1168                        ($maxfreq - $minfreq)
1169                              ? ($maxy - $miny) / ($maxfreq - $minfreq) : 1;
1170
1171                    if (defined($freqbase))
1172                    {
1173                        $FreqScale = 1;
1174                        $FreqScaleInv = "";
1175                    }
1176                    else
1177                    {
1178                        $FreqScale = 1;
1179                        $FreqScale = 10 ** int(log($s)/log(10) - 0.9999);
1180                        $FreqScaleInv =
1181                              ("$FreqScale" =~ /^10(0*)$/) ? "0.${1}1" :
1182                               ($FreqScale == 1 ? "" : (1/$FreqScale));
1183
1184                        $freqbase = ($maxfreq + $minfreq)/ 2 * $FreqScale; #$m * $FreqScale;
1185                        $freqbase -= ($maxy + $miny) / 2; #$lf->mean();
1186
1187                        ;# round resulting freqbase
1188                        ;# to precision of min max difference
1189                        $s = -12;
1190                        $s = int(log(($maxfreq-$minfreq)*$FreqScale)/log(10))-1
1191                              unless ($maxfreq-$minfreq) < 1e-12;
1192                        $s = 10 ** $s;
1193                        $freqbase = int($freqbase / $s) * $s;
1194                    }
1195              }
1196              else
1197              {
1198                    $FreqScale = 1;
1199                    $FreqScaleInv = "";
1200                    $freqbase = $m unless defined($freqbase);
1201                    if (($maxfreq - $minfreq) > $MinClip)
1202                    {
1203                        $f = (&abs($minfreq) < &abs($maxfreq))
1204                              ? $FuzzLow : $FuzzBig;
1205                        $miny = (($freqbase - $minfreq) <= ($f * $i))
1206                              ? ($minfreq-$freqbase) : (- $f * $i);
1207                        $f = ($f == $FuzzLow) ? $FuzzBig : $FuzzLow;
1208                        $maxy = (($maxfreq - $freqbase) <= ($f * $i))
1209                              ? ($maxfreq-$freqbase) : ($f * $i);
1210                    }
1211                    else
1212                    {
1213                        $miny = $minfreq - $freqbase;
1214                        $maxy = $maxfreq - $freqbase;
1215                    }
1216                    ($maxy - $miny) == 0 &&
1217                        (($maxy,$miny) =
1218                         (($maxfreq - $minfreq) > 0)
1219                         ? ($maxfreq-$freqbase,$minfreq-$freqbase) : (0.5,-0.5));
1220
1221                    $maxy = $MaxY if defined($MaxY) && $MaxY < $maxy;
1222                    $miny = $MinY if defined($MinY) && $MinY > $miny;
1223
1224                    print("frequency min clipped from ",$minfreq-$freqbase,
1225                          " to $miny\n")
1226                        if $verbose > 2 && $miny != ($minfreq - $freqbase);
1227                    print("frequency max clipped from ",$maxfreq-$freqbase,
1228                          " to $maxy\n")
1229                        if $verbose > 2 && $maxy != ($maxfreq - $freqbase);
1230              }
1231              $LastFreqBaseString =
1232                    sprintf("%g",$freqbase >= 0 ? $freqbase : -$freqbase);
1233              $LastFreqBase = $freqbase;
1234              print "LastFreqBaseString now \"$LastFreqBaseString\"\n"
1235                    if $verbose > 5;
1236          }
1237          else
1238          {
1239              $FreqScale = 1;
1240              $FreqScaleInv = "";
1241              $LastFreqBase = 0;
1242              $LastFreqBaseString = "";
1243          }
1244
1245          if ($showcmpl)
1246          {
1247              $mincmpl = &min(@cmpl);
1248              $maxcmpl = &max(@cmpl);
1249
1250              if (!defined($cmplscale))
1251              {
1252                    if (defined($maxy))
1253                    {
1254                        local($cmp)
1255                              = (&abs($miny) > &abs($maxy)) ? &abs($miny) : $maxy;
1256                        $cmplscale = $cmp == $maxy ? 1 : -1;
1257
1258                        foreach (0.01, 0.02, 0.05,
1259                                   0.1, 0.2, 0.25, 0.4, 0.5,
1260                                   1, 2, 4, 5,
1261                                   10, 20, 25, 50,
1262                                   100, 200, 250, 500, 1000)
1263                        {
1264                              $cmplscale *= $_, last if $maxcmpl/$_ <= $cmp;
1265                        }
1266                    }
1267                    else
1268                    {
1269                        $cmplscale = 1;
1270                        $miny = $mincmpl ? 0 : -$MinClip;
1271                        $maxy = $maxcmpl+$MinClip;
1272                    }
1273              }
1274              $LastCmplScale = $cmplscale;
1275          }
1276          else
1277          {
1278              $LastCmplScale = 1;
1279          }
1280
1281          print "creating plot command input file\n" if $verbose > 2;
1282
1283
1284          print OUT ("# preprocessed NTP statistics file for $STATHOST\n");
1285          print OUT ("#    timebase is: ",&ctime($LastTimeBase))
1286              if defined($LastTimeBase);
1287          print OUT ("#    frequency is offset by  ",
1288                       ($LastFreqBase >= 0 ? "+" : "-"),
1289                       "$LastFreqBaseString [${FreqScaleInv}ppm]\n");
1290          print OUT ("#    compliance is scaled by $LastCmplScale\n");
1291          print OUT ("# time [h]\toffset [ms]\tfrequency [${FreqScaleInv}ppm]\tcompliance\n");
1292
1293          printf OUT ("%s%lf\t%lf\t%lf\t%lf\n",
1294                        (shift(@break) ? "\n" : ""),
1295                        (shift(@time) - $LastTimeBase)/3600,
1296                        shift(@offs),
1297                        shift(@freq) * $FreqScale - $LastFreqBase,
1298                        shift(@cmpl) / $LastCmplScale)
1299              while(@time);
1300    }
1301    else
1302    {
1303          ;# prevent plotcmd from processing empty file
1304          print "Creating plot command dummy...\n" if $verbose > 2;
1305          print OUT "# dummy samples\n0 1 2 3\n1 1 2 3\n";
1306          $lo->sample(0,1);
1307          $lo->sample(1,1);
1308          $lf->sample(0,2);
1309          $lf->sample(1,2);
1310          @time = (0, 1); $maxtime = 1; $mintime = 0;
1311          @offs = (1, 1); $maxoffs = 1; $minoffs = 1;
1312          @freq = (2, 2); $maxfreq = 2; $minfreq = 2;
1313          @cmpl = (3, 3); $maxcmpl = 3; $mincmpl = 3;
1314          $LastCnt = 2;
1315          $LastFreqBase = 0;
1316          $LastCmplScale = 1;
1317          $LastTimeBase = 0;
1318          $miny = -$MinClip;
1319          $maxy = 3 + $MinClip;
1320    }
1321    close(OUT);
1322
1323    print "plot command input file created\n"
1324          if $verbose > 2;
1325
1326
1327    if (($fpos[$[] eq 'cnt' && scalar(@loffset) >= $cnt) ||
1328          ($fpos[$[] eq 'start' && $mintime <= $StartTime) ||
1329          ($fpos[$[] eq 'end'))
1330    {
1331          return ($fpos[$[],$filekey[$[],$loffset[$[]);
1332    }
1333    else                      # found to few lines - next time start search earlier in file
1334    {
1335          if ($fpos[$[] eq 'start')
1336          {
1337              ;# the timestamps we got for F_first and F_last guaranteed
1338              ;# that no file is left out
1339              ;# the only thing that could happen is:
1340              ;# we guessed the starting point wrong
1341              ;# compute a new guess from the first record found
1342              ;# if this equals our last guess use data of first record
1343              ;# otherwise try new guess
1344
1345              if ($fpos[$[+1] eq $filekey[$[] && $loffset[$[] > $fpos[$[+2])
1346              {
1347                    local($noff);
1348                    $noff = $loffset[$[] - ($cnt - @loffset + 1) * $RecordSize;
1349                    $noff = 0 if $noff < 0;
1350
1351                    return (@fpos[$[,$[+1], ($noff == $fpos[$[+2]) ? $loffset[$[] : $noff);
1352              }
1353              return ($fpos[$[],$filekey[$[],$loffset[$[]);
1354          }
1355          elsif ($fpos[$[] eq 'end' || $fpos[$[] eq 'cnt')
1356          {
1357              ;# try to start earlier in file
1358              ;# if we already started at the beginning
1359              ;# try to use previous file
1360              ;# this assumes distance to better starting point is at most one file
1361              ;# the primary guess at top of genfile() should usually allow this
1362              ;# assumption
1363              ;# if the offset of the first sample used is within
1364              ;# a different file than we guessed it must have occurred later
1365              ;# in the sequence of files
1366              ;# this only can happen if our starting file did not contain
1367              ;# a valid sample from the starting point we guessed
1368              ;# however this does not invalidate our assumption, no check needed
1369              local($noff,$key);
1370              if ($fpos[$[+2] > 0)
1371              {
1372                    $noff = $fpos[$[+2] - $RecordSize * ($cnt - @loffset + 1);
1373                    $noff = 0 if $noff < 0;
1374                    return (@fpos[$[,$[+1],$noff);
1375              }
1376              else
1377              {
1378                    if ($fpos[$[+1] eq $F_files[$[])
1379                    {
1380                        ;# first file - and not enough samples
1381                        ;# use data of first sample
1382                        return ($fpos[$[], $filekey[$[], $loffset[$[]);
1383                    }
1384                    else
1385                    {
1386                        ;# search key of previous file
1387                        $key = $F_files[$[];
1388                        @F = reverse(@F_files);
1389                        while ($_ = shift(@F))
1390                        {
1391                              if ($_ eq $fpos[$[+1])
1392                              {
1393                                  $key = shift(@F) if @F;
1394                                  last;
1395                              }
1396                        }
1397                        $noff = int($F_size{$key} / $RecordSize);
1398                        $noff -= $cnt - @loffset;
1399                        $noff = 0 if $noff < 0;
1400                        $noff *= $RecordSize;
1401                        return ($fpos[$[], $key, $noff);
1402                    }
1403              }
1404          }
1405          else
1406          {
1407              return ();
1408          }
1409
1410          return 0 if @loffset <= 1 || ($loffset[$#loffset] - $loffset[$[]) <= 1;
1411
1412          ;# EOF - 1.1 * avg(line) * $cnt
1413          local($val) =  $loffset[$#loffset]
1414              - $cnt * 11 * (($loffset[$#loffset] - $loffset[$[]) / @loffset) / 10;
1415          return ($val < 0) ? 0 : $val;
1416    }
1417}
1418
1419$Ltime = -1 if ! defined($Ltime);
1420$LastFreqBase = 0;
1421$LastFreqBaseString = "??";
1422
1423;# initial setup of plot
1424print "initialize plotting\n" if $verbose;
1425if (defined($PrintIt))
1426{
1427  if ($PrintIt =~ m,/,)
1428  {
1429    print "Saving plot to file $PrintIt\n";
1430    print PLOT "set output '$PrintIt'\n";
1431  }
1432  else
1433  {
1434    print "Printing plot on printer $PrintIt\n";
1435    print PLOT "set output '| lpr -P$PrintIt -h'\n";
1436  }
1437  print PLOT "set terminal postscript landscape color solid 'Helvetica' 10\n";
1438}
1439print PLOT "set grid\n";
1440print PLOT "set tics out\n";
1441print PLOT "set format y '%g '\n";
1442printf PLOT "set time 47\n" unless defined($PrintIt);
1443
1444@filepos =();
1445while(1)
1446{
1447  print &ctime(time) if $verbose;
1448
1449  ;# update diplay characteristics
1450  &read_config;# unless defined($PrintIt);
1451
1452  unlink($tmpfile);
1453  my $lo = lr->new();
1454  my $lf = lr->new();
1455
1456  @filepos = &genfile($samples,$srcprefix,$tmpfile,$lo,$lf,@filepos);
1457
1458  ;# make plotcmd display samples
1459  make_doplot($lo, $lf);
1460  print "Displaying plot...\n" if $verbose > 1;
1461  print "command for plot sub process:\n$doplot----\n" if $verbose > 3;
1462  print PLOT $doplot;
1463}
1464continue
1465{
1466  if (defined($PrintIt))
1467  {
1468    delete $SIG{'CHLD'};
1469    print PLOT "quit\n";
1470    close(PLOT);
1471    if ($PrintIt =~ m,/,)
1472    {
1473      print "Plot saved to file $PrintIt\n";
1474    }
1475    else
1476    {
1477      print "Plot spooled to printer $PrintIt\n";
1478    }
1479    unlink($tmpfile);
1480    exit(0);
1481  }
1482  ;# wait $delay seconds
1483  print "waiting $delay seconds ..." if $verbose > 2;
1484  sleep($delay);
1485  print " continuing\n" if $verbose > 2;
1486  undef($LastFreqBaseString);
1487}
1488
1489
1490sub date_time_spec2seconds
1491{
1492    local($_) = @_;
1493    ;# a date_time_spec consistes of:
1494    ;#  YYYY-MM-DD_HH:MM:SS.ms
1495    ;# values can be omitted from the beginning and default than to
1496    ;# values of current date
1497    ;# values omitted from the end default to lowest possible values
1498
1499    local($time) = time;
1500    local($sec,$min,$hour,$mday,$mon,$year)
1501          = localtime($time);
1502
1503    local($last) = ();
1504
1505    s/^\D*(.*\d)\D*/$1/;      # strip off garbage
1506
1507  PARSE:
1508    {
1509          if (s/^(\d{4})(-|$)//)
1510          {
1511              if ($1 < 1970)
1512              {
1513                    warn("$0: can not handle years before 1970 - year $1 ignored\n");
1514                    return undef;
1515              }
1516              elsif ( $1 >= 2070)
1517              {
1518                    warn("$0: can not handle years past 2070 - year $1 ignored\n");
1519                    return undef;
1520              }
1521              else
1522              {
1523                    $year = $1 % 100; # 0<= $year < 100
1524                                         ;# - interpreted 70 .. 99,00 .. 69
1525              }
1526              $last = $[ + 5;
1527              last PARSE if $_ eq '';
1528              warn("$0: bad date_time_spec: \"$_\" found after YEAR\n"),
1529              return(undef)
1530                    if $2 eq '';
1531          }
1532
1533          if (s/^(\d{1,2})(-|$)//)
1534          {
1535              warn("$0: implausible month $1\n"),return(undef)
1536                    if $1 < 1 || $1 > 12;
1537              $mon = $1 - 1;
1538              $last = $[ + 4;
1539              last PARSE if $_ eq '';
1540              warn("$0: bad date_time_spec: \"$_\" found after MONTH\n"),
1541              return(undef)
1542                    if $2 eq '';
1543          }
1544          else
1545          {
1546              warn("$0: bad date_time_spec \"$_\"\n"),return(undef)
1547                    if defined($last);
1548
1549          }
1550
1551          if (s/^(\d{1,2})([_ ]|$)//)
1552          {
1553              warn("$0: implausible month day $1 for month ".($mon+1)." (".
1554                     $MaxNumDaysPerMonth[$mon].")$mon\n"),
1555              return(undef)
1556                    if $1 < 1 || $1 > $MaxNumDaysPerMonth[$mon];
1557              $mday = $1;
1558              $last = $[ + 3;
1559              last PARSE if $_ eq '';
1560              warn("$0: bad date_time_spec \"$_\" found after MDAY\n"),
1561              return(undef)
1562                    if $2 eq '';
1563          }
1564          else
1565          {
1566              warn("$0: bad date_time_spec \"$_\"\n"), return undef
1567                    if defined($last);
1568          }
1569
1570          ;# now we face a problem:
1571          ;# if ! defined($last) a prefix of "07:"
1572          ;# can be either 07:MM or 07:ss
1573          ;# to get the second interpretation make the user add
1574          ;# a msec fraction part and check for this special case
1575          if (! defined($last) && s/^(\d{1,2}):(\d{1,2}\.\d+)//)
1576          {
1577              warn("$0: implausible minute $1\n"), return undef
1578                    if $1 < 0 || $1 >= 60;
1579              warn("$0: implausible second $1\n"), return undef
1580                    if $2 < 0 || $2 >= 60;
1581              $min = $1;
1582              $sec = $2;
1583              $last = $[ + 1;
1584              last PARSE if $_ eq '';
1585              warn("$0: bad date_time_spec \"$_\" after SECONDS\n");
1586              return undef;
1587          }
1588
1589          if (s/^(\d{1,2})(:|$)//)
1590          {
1591              warn("$0: implausible hour $1\n"), return undef
1592                    if $1 < 0 || $1 > 24;
1593              $hour = $1;
1594              $last = $[ + 2;
1595              last PARSE if $_ eq '';
1596              warn("$0: bad date_time_spec found \"$_\" after HOUR\n"),
1597              return undef
1598                    if $2 eq '';
1599          }
1600          else
1601          {
1602              warn("$0: bad date_time_spec \"$_\"\n"), return undef
1603                    if defined($last);
1604          }
1605
1606          if (s/^(\d{1,2})(:|$)//)
1607          {
1608              warn("$0: implausible minute $1\n"), return undef
1609                    if $1 < 0 || $1 >=60;
1610              $min = $1;
1611              $last = $[ + 1;
1612              last PARSE if $_ eq '';
1613              warn("$0: bad date_time_spec found \"$_\" after MINUTE\n"),
1614              return undef
1615                    if $2 eq '';
1616          }
1617          else
1618          {
1619              warn("$0: bad date_time_spec \"$_\"\n"), return undef
1620                    if defined($last);
1621          }
1622
1623          if (s/^(\d{1,2}(\.\d+)?)//)
1624          {
1625              warn("$0: implausible second $1\n"), return undef
1626                    if $1 < 0 || $1 >=60;
1627              $sec = $1;
1628              $last = $[;
1629              last PARSE if $_ eq '';
1630              warn("$0: bad date_time_spec found \"$_\" after SECOND\n");
1631              return undef;
1632          }
1633    }
1634
1635    return $time unless defined($last);
1636
1637    $sec  = 0 if $last > $[;
1638    $min  = 0 if $last > $[ + 1;
1639    $hour = 0 if $last > $[ + 2;
1640    $mday = 1 if $last > $[ + 3;
1641    $mon  = 0 if $last > $[ + 4;
1642    local($rtime) = &timelocal($sec,$min,$hour,$mday,$mon,$year, 0,0, 0);
1643
1644    ;# $rtime may be off if daylight savings time is in effect at given date
1645    return $rtime + ($sec - int($sec))
1646          if $hour == (localtime($rtime))[$[+2];
1647    return
1648          &timelocal($sec,$min,$hour,$mday,$mon,$year, 0,0, 1)
1649              + ($sec - int($sec));
1650}
1651
1652
1653sub min
1654{
1655  local($m) = shift;
1656
1657  grep((($m > $_) && ($m = $_),0),@_);
1658  $m;
1659}
1660
1661sub max
1662{
1663  local($m) = shift;
1664
1665  grep((($m < $_) && ($m = $_),0),@_);
1666  $m;
1667}
1668