contrib/ntp/scripts/monitoring/ntploopwatch

   1 #!/usr/bin/perl -w
   2 ;# --*-perl-*--
   3 ;#
   4 ;# /src/NTP/ntp-4/scripts/monitoring/ntploopwatch,v 4.3 1999/02/21 12:18:38 kardel RELEASE_19990228_A
   5 ;# RELEASE_19990228_A
   6 ;#
   7 ;# process loop filter statistics file and either
   8 ;#     - show statistics periodically using gnuplot
   9 ;#     - or print a single plot
  10 ;#
  11 ;#  Copyright (c) 1992-1998
  12 ;#  Rainer Pruy, Friedrich-Alexander Universität Erlangen-Nürnberg
  13 ;#
  14 ;#
  15 ;#############################################################
  16 $0 =~ s!^.*/([^/]+)$!$1!;
  17 $F = ' ' x length($0);
  18 $|=1;
  19
  20 $ENV{'SHELL'} = '/bin/sh'; # use bourne shell
  21
  22 undef($config);
  23 undef($workdir);
  24 undef($PrintIt);
  25 undef($samples);
  26 undef($StartTime);
  27 undef($EndTime);
  28 ($a,$b) if 0;                   # keep -w happy
  29 $usage = <<"E-O-P";
  30 usage:
  31   to watch statistics permanently:
  32      $0 [-v[<level>]] [-c <config-file>] [-d <working-dir>]
  33      $F [-h <hostname>]
  34
  35   to get a single print out specify also
  36      $F -P[<printer>] [-s<samples>]
  37      $F               [-S <start-time>] [-E <end-time>]
  38      $F               [-Y <MaxOffs>] [-y <MinOffs>]
  39
  40 If You like long option names, You can use:
  41     -help
  42     -c    +config
  43     -d    +directory
  44     -h    +host
  45     -v    +verbose[=<level>]
  46     -P    +printer[=<printer>]
  47     -s    +samples[=<samples>]
  48     -S    +starttime
  49     -E    +endtime
  50     -Y    +maxy
  51     -y    +miny
  52
  53 If <printer> contains a '/' (slash character) output is directed to
  54 a file of this name instead of delivered to a printer.
  55 E-O-P
  56
  57 ;# add directory to look for lr.pl and timelocal.pl (in front of current list)
  58 unshift(@INC,"/usr/local/xntp/monitoring");
  59
  60 require "lr.pl";        # linear regresion routines
  61
  62 $MJD_1970 = 40587;              # from ntp.h (V3)
  63 $RecordSize = 48;               # usually a line fits into 42 bytes
  64 $MinClip = 1;           # clip Y scales with greater range than this
  65
  66 ;# largest extension of Y scale from mean value, factor for standart deviation
  67 $FuzzLow = 2.2;                 # for side closer to zero
  68 $FuzzBig = 1.8;                 # for side farther from zero
  69
  70 require "ctime.pl";
  71 require "timelocal.pl";
  72 ;# early distributions of ctime.pl had a bug
  73 $ENV{'TZ'} = 'MET' unless defined $ENV{'TZ'} || $[ > 4.010;
  74 if (defined(@ctime'MoY))
  75 {
  76   *Month=*ctime'MoY;
  77   *Day=*ctime'DoW;
  78 }                                       # ' re-sync emacs fontification
  79 else
  80 {
  81   @Month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
  82   @Day   = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
  83 }
  84 print @ctime'DoW if 0; # ' re-sync emacs fontification
  85
  86 ;# max number of days per month
  87 @MaxNumDaysPerMonth = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  88
  89 ;# config settable parameters
  90 $delay = 60;
  91 $srcprefix = "./var\@\$STATHOST/loopstats.";
  92 $showoffs = 1;
  93 $showfreq = 1;
  94 $showcmpl = 0;
  95 $showoreg = 0;
  96 $showfreg = 0;
  97 undef($timebase);
  98 undef($freqbase);
  99 undef($cmplscale);
 100 undef($MaxY);
 101 undef($MinY);
 102 $deltaT  = 512; # indicate sample data gaps greater than $deltaT seconds
 103 $verbose = 1;
 104
 105 while($_ = shift(@ARGV))
 106 {
 107     (/^[+-]help$/) && die($usage);
 108
 109     (/^-c$/ || /^\+config$/) &&
 110         (@ARGV || die($usage), $config = shift(@ARGV), next);
 111
 112     (/^-d$/ || /^\+directory$/) &&
 113         (@ARGV || die($usage), $workdir = shift(@ARGV), next);
 114
 115     (/^-h$/ || /^\+host$/) &&
 116         (@ARGV || die($usage), $STATHOST = shift, next);
 117
 118     (/^-v(\d*)$/ || /^\+verbose=?(\d*)$/) &&
 119         ($verbose=($1 eq "") ? 1 : $1, next);
 120
 121     (/^-P(\S*)$/ || /^\+[Pp]rinter=?(\S*)$/) &&
 122         ($PrintIt = $1, $verbose==1 && ($verbose = 0), next);
 123
 124     (/^-s(\d*)$/ || /^\+samples=?(\d*)$/) &&
 125         (($samples = ($1 eq "") ? (shift || die($usage)): $1), next);
 126
 127     (/^-S$/ || /^\+[Ss]tart[Tt]ime$/) &&
 128         (@ARGV || die($usage), $StartTime=&date_time_spec2seconds(shift),next);
 129
 130     (/^-E$/ || /^\+[Ee]nd[Tt]ime$/) &&
 131         (@ARGV || die($usage), $EndTime = &date_time_spec2seconds(shift),next);
 132
 133     (/^-Y$/ || /^\+[Mm]ax[Yy]$/) &&
 134         (@ARGV || die($usage), $MaxY = shift, next);
 135
 136     (/^-y$/ || /^\+[Mm]in[Yy]$/) &&
 137         (@ARGV || die($usage), $MinY = shift, next);
 138
 139     die("$0: unexpected argument \"$_\"\n$usage");
 140 }
 141
 142 if (defined($workdir))
 143 {
 144   chdir($workdir) ||
 145       die("$0: failed to change working dir to \"$workdir\": $!\n");
 146 }
 147
 148 $PrintIt = "ps" if defined($PrintIt) && $PrintIt eq "";
 149
 150 if (!defined($PrintIt))
 151 {
 152     defined($samples) &&
 153         print "WARNING: your samples value may be shadowed by config file settings\n";
 154     defined($StartTime) &&
 155         print "WARNING: your StartTime value may be shadowed by config file settings\n";
 156     defined($EndTime) &&
 157         print "WARNING: your EndTime value may be shadowed by config file settings\n";
 158     defined($MaxY) &&
 159         print "WARNING: your MaxY value may be shadowed by config file settings\n";
 160     defined($MinY) &&
 161         print "WARNING: your MinY value may be shadowed by config file settings\n";
 162
 163     ;# check operating environment
 164     ;#
 165     ;# gnuplot usually has X support
 166     ;# I vaguely remember there was one with sunview support
 167     ;#
 168     ;# If Your plotcmd can display graphics using some other method
 169     ;# (Tek window,..) fix the following test
 170     ;# (or may be, just disable it)
 171     ;#
 172     !(defined($ENV{'DISPLAY'}) || defined($ENV{'WINDOW_PARENT'})) &&
 173         die("Need window system to monitor statistics\n");
 174 }
 175
 176 ;# configuration file
 177 $config = "loopwatch.config" unless defined($config);
 178 ($STATHOST = $config) =~ s!.*loopwatch\.config.([^/\.]*)$!$1!
 179     unless defined($STATHOST);
 180 ($STATTAG = $STATHOST) =~ s/^([^\.\*\s]+)\..*$/$1/;
 181
 182 $srcprefix =~ s/\$STATHOST/$STATHOST/g;
 183
 184 ;# plot command
 185 @plotcmd=("gnuplot",
 186           '-title', "Ntp loop filter statistics $STATHOST",
 187           '-name', "NtpLoopWatch_$STATTAG");
 188 $tmpfile = "/tmp/ntpstat.$$";
 189
 190 ;# other variables
 191 $doplot = "";   # assembled command for @plotcmd to display plot
 192 undef($laststat);
 193
 194 ;# plot value ranges
 195 undef($mintime);
 196 undef($maxtime);
 197 undef($minoffs);
 198 undef($maxoffs);
 199 undef($minfreq);
 200 undef($maxfreq);
 201 undef($mincmpl);
 202 undef($maxcmpl);
 203 undef($miny);
 204 undef($maxy);
 205
 206 ;# stop operation if plot command dies
 207 sub sigchld
 208 {
 209   local($pid) = wait;
 210   unlink($tmpfile);
 211   warn(sprintf("%s: %s died: exit status: %d signal %d\n",
 212               $0,
 213                (defined($Plotpid) && $Plotpid == $pid)
 214                ? "plotcmd" : "unknown child $pid",
 215                $?>>8,$? & 0xff)) if $?;
 216   exit(1) if $? && defined($Plotpid) && $pid == $Plotpid;
 217 }
 218 &sigchld if 0;
 219 $SIG{'CHLD'} = "sigchld";
 220 $SIG{'CLD'} = "sigchld";
 221
 222 sub abort
 223 {
 224   unlink($tmpfile);
 225   defined($Plotpid) && kill('TERM',$Plotpid);
 226   die("$0: received signal SIG$_[$[] - exiting\n");
 227 }
 228 &abort if 0;    # make -w happy - &abort IS used
 229 $SIG{'INT'} = $SIG{'HUP'} = $SIG{'QUIT'} = $SIG{'TERM'} = $SIG{'PIPE'} = "abort";
 230
 231 ;#
 232 sub abs
 233 {
 234   ($_[$[] < 0) ? -($_[$[]) : $_[$[];
 235 }
 236
 237 sub boolval
 238 {
 239   local($v) = ($_[$[]);
 240
 241   return 1 if ($v eq 'yes') || ($v eq 'y');
 242   return 1 if ($v =~ /^[0-9]*$/) && ($v != 0);
 243   return 0;
 244 }
 245
 246 ;#####################
 247 ;# start of real work
 248
 249 print "starting plot command (" . join(" ",@plotcmd) . ")\n" if $verbose > 1;
 250
 251 $Plotpid = open(PLOT,"|-");
 252 select((select(PLOT),$|=1)[$[]);        # make PLOT line bufferd
 253
 254 defined($Plotpid) ||
 255     die("$0: failed to start plot command: $!\n");
 256
 257 unless ($Plotpid)
 258 {
 259    ;# child == plot command
 260    close(STDOUT);
 261    open(STDOUT,">&STDERR") ||
 262        die("$0: failed to redirect STDOUT of plot command: $!\n");
 263
 264    print STDOUT "plot command running as $$\n";
 265
 266    exec @plotcmd;
 267    die("$0: failed to exec (@plotcmd): $!\n");
 268    exit(1); # in case ...
 269 }
 270
 271 sub read_config
 272 {
 273   local($at) = (stat($config))[$[+9];
 274   local($_,$c,$v);
 275
 276   (undef($laststat),(print("stat $config failed: $!\n")),return) if ! defined($at);
 277   return if (defined($laststat) && ($laststat == $at));
 278   $laststat = $at;
 279
 280   print "reading configuration from \"$config\"\n" if $verbose;
 281
 282   open(CF,"<$config") ||
 283       (warn("$0: failed to read \"$config\" - using old settings ($!)\n"),
 284        return);
 285   while(<CF>)
 286   {
 287     chop;
 288     s/^([^\#]*[^\#\s]?)\s*\#.*$//;
 289     next if /^\s*$/;
 290
 291     s/^\s*([^=\s]*)\s*=\s*(.*\S)\s*$/$1=$2/;
 292
 293     ($c,$v) = split(/=/,$_,2);
 294     print "processing \"$c=$v\"\n" if $verbose > 3;
 295     ($c eq "delay") && ($delay = $v,1) && next;
 296     ($c eq 'samples') && (!defined($PrintIt) || !defined($samples)) &&
 297         ($samples = $v,1) && next;
 298     ($c eq 'srcprefix') && (($srcprefix=$v)=~s/\$STATHOST/$STATHOST/g,1)
 299         && next;
 300     ($c eq 'showoffs') &&
 301         ($showoffs = boolval($v),1) && next;
 302     ($c eq 'showfreq') &&
 303         ($showfreq = boolval($v),1) && next;
 304     ($c eq 'showcmpl') &&
 305         ($showcmpl = boolval($v),1) && next;
 306     ($c eq 'showoreg') &&
 307         ($showoreg = boolval($v),1) && next;
 308     ($c eq 'showfreg') &&
 309         ($showfreg = boolval($v),1) && next;
 310
 311     ($c eq 'exit') && (unlink($tmpfile),die("$0: exit by config request\n"));
 312
 313     ($c eq 'freqbase' ||
 314      $c eq 'cmplscale') &&
 315         do {
 316             if (! defined($v) || $v eq "" || $v eq 'dynamic')
 317             {
 318               eval "undef(\$$c);";
 319             }
 320             else
 321             {
 322               eval "\$$c = \$v;";
 323             }
 324             next;
 325         };
 326     ($c eq 'timebase') &&
 327         do {
 328             if (! defined($v) || $v eq "" || $v eq "dynamic")
 329             {
 330               undef($timebase);
 331             }
 332             else
 333             {
 334               $timebase=&date_time_spec2seconds($v);
 335             }
 336         };
 337     ($c eq 'EndTime') &&
 338         do {
 339             next if defined($EndTime) && defined($PrintIt);
 340             if (! defined($v) || $v eq "" || $v eq "none")
 341             {
 342               undef($EndTime);
 343             }
 344             else
 345             {
 346               $EndTime=&date_time_spec2seconds($v);
 347             }
 348         };
 349     ($c eq 'StartTime') &&
 350         do {
 351             next if defined($StartTime) && defined($PrintIt);
 352             if (! defined($v) || $v eq "" || $v eq "none")
 353             {
 354               undef($StartTime);
 355             }
 356             else
 357             {
 358               $StartTime=&date_time_spec2seconds($v);
 359             }
 360         };
 361
 362     ($c eq 'MaxY') &&
 363         do {
 364             next if defined($MaxY) && defined($PrintIt);
 365             if (! defined($v) || $v eq "" || $v eq "none")
 366             {
 367               undef($MaxY);
 368             }
 369             else
 370             {
 371               $MaxY=$v;
 372             }
 373         };
 374
 375     ($c eq 'MinY') &&
 376         do {
 377             next if defined($MinY) && defined($PrintIt);
 378             if (! defined($v) || $v eq "" || $v eq "none")
 379             {
 380               undef($MinY);
 381             }
 382             else
 383             {
 384               $MinY=$v;
 385             }
 386         };
 387
 388     ($c eq 'deltaT') &&
 389         do {
 390             if (!defined($v) || $v eq "")
 391             {
 392               undef($deltaT);
 393             }
 394             else
 395             {
 396               $deltaT = $v;
 397             }
 398             next;
 399         };
 400     ($c eq 'verbose') && ! defined($PrintIt) &&
 401         do {
 402              if (!defined($v) || $v == 0)
 403              {
 404                $verbose = 0;
 405              }
 406              else
 407              {
 408                $verbose = $v;
 409              }
 410              next;
 411         };
 412     ;# otherwise: silently ignore unrecognized config line
 413   }
 414   close(CF);
 415   ;# set show defaults when nothing selected
 416   $showoffs = $showfreq = $showcmpl = 1
 417       unless $showoffs || $showfreq || $showcmpl;
 418   if ($verbose > 3)
 419   {
 420     print  "new configuration:\n";
 421     print  "   delay\t= $delay\n";
 422     print  "   samples\t= $samples\n";
 423     print  "   srcprefix\t= $srcprefix\n";
 424     print  "   showoffs\t= $showoffs\n";
 425     print  "   showfreq\t= $showfreq\n";
 426     print  "   showcmpl\t= $showcmpl\n";
 427     print  "   showoreg\t= $showoreg\n";
 428     print  "   showfreg\t= $showfreg\n";
 429     printf "   timebase\t= %s",defined($timebase)?&ctime($timebase):"dynamic\n";
 430     printf "   freqbase\t= %s\n",defined($freqbase)  ?"$freqbase":"dynamic";
 431     printf "   cmplscale\t= %s\n",defined($cmplscale)?"$cmplscale":"dynamic";
 432     printf "   StartTime\t= %s",defined($StartTime)?&ctime($StartTime):"none\n";
 433     printf "   EndTime\t= %s",  defined($EndTime) ?  &ctime($EndTime):"none\n";
 434     printf "   MaxY\t= %s",defined($MaxY)? $MaxY      :"none\n";
 435     printf "   MinY\t= %s",defined($MinY)? $MinY      :"none\n";
 436     print  "   verbose\t= $verbose\n";
 437   }
 438 print "configuration file read\n" if $verbose > 2;
 439 }
 440
 441 sub make_doplot
 442 {
 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                             &lr_B('offs'),&lr_A('offs'),
 540                             "offset   ",
 541                             &lr_B('offs'),
 542                             ((&lr_A('offs')) < 0 ? '-' : '+'),
 543                             &abs(&lr_A('offs')), &lr_r('offs'),
 544                             "[ms]"),
 545          $c = ",");
 546     $showfreg && $showfreq &&
 547         ($doplot .= sprintf($regfmt, $c,
 548                             &lr_B('freq') * $FreqScale,
 549                             (&lr_A('freq') + $minfreq) * $FreqScale - $LastFreqBase,
 550                             "frequency",
 551                             &lr_B('freq') * $FreqScale,
 552                             ((&lr_A('freq') + $minfreq) * $FreqScale - $LastFreqBase) < 0 ? '-' : '+',
 553                             &abs((&lr_A('freq') + $minfreq) * $FreqScale - $LastFreqBase),
 554                             &lr_r('freq'),
 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
 567 sub genfile
 568 {
 569     local($cnt,$in,$out,@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     &lr_init('offs');
1062     &lr_init('freq');
1063
1064     if (@time)
1065     {
1066         local($_,@F);
1067
1068         local($timebase) unless defined($timebase);
1069         local($freqbase) unless defined($freqbase);
1070         local($cmplscale) unless defined($cmplscale);
1071
1072         undef $mintime;
1073         undef $maxtime;
1074         undef $minoffs;
1075         undef $maxoffs;
1076         undef $minfreq;
1077         undef $maxfreq;
1078         undef $mincmpl;
1079         undef $maxcmpl;
1080         undef $miny;
1081         undef $maxy ;
1082
1083         print "computing ranges\n" if $verbose > 2;
1084
1085         $LastCnt = @time;
1086
1087         ;# @time is in ascending order (;-)
1088         $mintime = $time[$[];
1089         $maxtime = $time[$#time];
1090         unless (defined($timebase))
1091         {
1092             local($time,@X) = (time);
1093             @X = localtime($time);
1094
1095             ;# compute today 00:00:00
1096             $timebase = $time - ((($X[$[+2]*60)+$X[$[+1])*60+$X[$[]);
1097
1098         }
1099         $LastTimeBase = $timebase;
1100
1101         if ($showoffs)
1102         {
1103             local($i,$m,$f);
1104
1105             $minoffs = &min(@offs);
1106             $maxoffs = &max(@offs);
1107
1108             ;# I know, it is not perl style using indices to access arrays,
1109             ;# but I have to proccess two arrays in sync, non-destructively
1110             ;# (otherwise a (shift(@a1),shift(a2)) would do),
1111             ;# I dont like to make copies of these arrays as they may be huge
1112             $i = $[;
1113             &lr_sample(($time[$i]-$timebase)/3600,$offs[$i],'offs'),$i++
1114                 while $i <= $#time;
1115
1116             ($minoffs == $maxoffs) && ($minoffs -= 0.1,$maxoffs += 0.1);
1117
1118             $i = &lr_sigma('offs');
1119             $m = &lr_mean('offs');
1120
1121             print "mean offset: $m sigma: $i\n" if $verbose > 2;
1122
1123             if (($maxoffs - $minoffs) > $MinClip)
1124             {
1125                 $f = (&abs($minoffs) < &abs($maxoffs)) ? $FuzzLow : $FuzzBig;
1126                 $miny = (($m - $minoffs) <= ($f * $i))
1127                     ? $minoffs : ($m - $f * $i);
1128                 $f = ($f == $FuzzLow) ? $FuzzBig : $FuzzLow;
1129                 $maxy = (($maxoffs - $m) <= ($f * $i))
1130                     ? $maxoffs : ($m + $f * $i);
1131             }
1132             else
1133             {
1134                 $miny = $minoffs;
1135                 $maxy = $maxoffs;
1136             }
1137             ($maxy-$miny) == 0 &&
1138                 (($maxy,$miny)
1139                  = (($maxoffs - $minoffs) > 0)
1140                  ? ($maxoffs,$minoffs) : ($MinClip,-$MinClip));
1141
1142             $maxy = $MaxY if defined($MaxY) && $MaxY < $maxy;
1143             $miny = $MinY if defined($MinY) && $MinY > $miny;
1144
1145             print  "offset min clipped from $minoffs to $miny\n"
1146                 if $verbose > 2 && $minoffs != $miny;
1147             print  "offset max clipped from $maxoffs to $maxy\n"
1148                 if $verbose > 2 && $maxoffs != $maxy;
1149         }
1150
1151         if ($showfreq)
1152         {
1153             local($i,$m);
1154
1155             $minfreq = &min(@freq);
1156             $maxfreq = &max(@freq);
1157
1158             $i = $[;
1159             &lr_sample(($time[$i]-$timebase)/3600,$freq[$i]-$minfreq,'freq'),
1160             $i++
1161                 while $i <= $#time;
1162
1163             $i = &lr_sigma('freq');
1164             $m = &lr_mean('freq') + $minfreq;
1165
1166             print "mean frequency: $m sigma: $i\n" if $verbose > 2;
1167
1168             if (defined($maxy))
1169             {
1170                 local($s) =
1171                     ($maxfreq - $minfreq)
1172                         ? ($maxy - $miny) / ($maxfreq - $minfreq) : 1;
1173
1174                 if (defined($freqbase))
1175                 {
1176                     $FreqScale = 1;
1177                     $FreqScaleInv = "";
1178                 }
1179                 else
1180                 {
1181                     $FreqScale = 1;
1182                     $FreqScale = 10 ** int(log($s)/log(10) - 0.9999);
1183                     $FreqScaleInv =
1184                         ("$FreqScale" =~ /^10(0*)$/) ? "0.${1}1" :
1185                          ($FreqScale == 1 ? "" : (1/$FreqScale));
1186
1187                     $freqbase = ($maxfreq + $minfreq)/ 2 * $FreqScale; #$m * $FreqScale;
1188                     $freqbase -= ($maxy + $miny) / 2; #&lr_mean('offs');
1189
1190                     ;# round resulting freqbase
1191                     ;# to precision of min max difference
1192                     $s = -12;
1193                     $s = int(log(($maxfreq-$minfreq)*$FreqScale)/log(10))-1
1194                         unless ($maxfreq-$minfreq) < 1e-12;
1195                     $s = 10 ** $s;
1196                     $freqbase = int($freqbase / $s) * $s;
1197                 }
1198             }
1199             else
1200             {
1201                 $FreqScale = 1;
1202                 $FreqScaleInv = "";
1203                 $freqbase = $m unless defined($freqbase);
1204                 if (($maxfreq - $minfreq) > $MinClip)
1205                 {
1206                     $f = (&abs($minfreq) < &abs($maxfreq))
1207                         ? $FuzzLow : $FuzzBig;
1208                     $miny = (($freqbase - $minfreq) <= ($f * $i))
1209                         ? ($minfreq-$freqbase) : (- $f * $i);
1210                     $f = ($f == $FuzzLow) ? $FuzzBig : $FuzzLow;
1211                     $maxy = (($maxfreq - $freqbase) <= ($f * $i))
1212                         ? ($maxfreq-$freqbase) : ($f * $i);
1213                 }
1214                 else
1215                 {
1216                     $miny = $minfreq - $freqbase;
1217                     $maxy = $maxfreq - $freqbase;
1218                 }
1219                 ($maxy - $miny) == 0 &&
1220                     (($maxy,$miny) =
1221                      (($maxfreq - $minfreq) > 0)
1222                      ? ($maxfreq-$freqbase,$minfreq-$freqbase) : (0.5,-0.5));
1223
1224                 $maxy = $MaxY if defined($MaxY) && $MaxY < $maxy;
1225                 $miny = $MinY if defined($MinY) && $MinY > $miny;
1226
1227                 print("frequency min clipped from ",$minfreq-$freqbase,
1228                       " to $miny\n")
1229                     if $verbose > 2 && $miny != ($minfreq - $freqbase);
1230                 print("frequency max clipped from ",$maxfreq-$freqbase,
1231                       " to $maxy\n")
1232                     if $verbose > 2 && $maxy != ($maxfreq - $freqbase);
1233             }
1234             $LastFreqBaseString =
1235                 sprintf("%g",$freqbase >= 0 ? $freqbase : -$freqbase);
1236             $LastFreqBase = $freqbase;
1237             print "LastFreqBaseString now \"$LastFreqBaseString\"\n"
1238                 if $verbose > 5;
1239         }
1240         else
1241         {
1242             $FreqScale = 1;
1243             $FreqScaleInv = "";
1244             $LastFreqBase = 0;
1245             $LastFreqBaseString = "";
1246         }
1247
1248         if ($showcmpl)
1249         {
1250             $mincmpl = &min(@cmpl);
1251             $maxcmpl = &max(@cmpl);
1252
1253             if (!defined($cmplscale))
1254             {
1255                 if (defined($maxy))
1256                 {
1257                     local($cmp)
1258                         = (&abs($miny) > &abs($maxy)) ? &abs($miny) : $maxy;
1259                     $cmplscale = $cmp == $maxy ? 1 : -1;
1260
1261                     foreach (0.01, 0.02, 0.05,
1262                              0.1, 0.2, 0.25, 0.4, 0.5,
1263                              1, 2, 4, 5,
1264                              10, 20, 25, 50,
1265                              100, 200, 250, 500, 1000)
1266                     {
1267                         $cmplscale *= $_, last if $maxcmpl/$_ <= $cmp;
1268                     }
1269                 }
1270                 else
1271                 {
1272                     $cmplscale = 1;
1273                     $miny = $mincmpl ? 0 : -$MinClip;
1274                     $maxy = $maxcmpl+$MinClip;
1275                 }
1276             }
1277             $LastCmplScale = $cmplscale;
1278         }
1279         else
1280         {
1281             $LastCmplScale = 1;
1282         }
1283
1284         print "creating plot command input file\n" if $verbose > 2;
1285
1286
1287         print OUT ("# preprocessed NTP statistics file for $STATHOST\n");
1288         print OUT ("#    timebase is: ",&ctime($LastTimeBase))
1289             if defined($LastTimeBase);
1290         print OUT ("#    frequency is offset by  ",
1291                    ($LastFreqBase >= 0 ? "+" : "-"),
1292                    "$LastFreqBaseString [${FreqScaleInv}ppm]\n");
1293         print OUT ("#    compliance is scaled by $LastCmplScale\n");
1294         print OUT ("# time [h]\toffset [ms]\tfrequency [${FreqScaleInv}ppm]\tcompliance\n");
1295
1296         printf OUT ("%s%lf\t%lf\t%lf\t%lf\n",
1297                     (shift(@break) ? "\n" : ""),
1298                     (shift(@time) - $LastTimeBase)/3600,
1299                     shift(@offs),
1300                     shift(@freq) * $FreqScale - $LastFreqBase,
1301                     shift(@cmpl) / $LastCmplScale)
1302             while(@time);
1303     }
1304     else
1305     {
1306         ;# prevent plotcmd from processing empty file
1307         print "Creating plot command dummy...\n" if $verbose > 2;
1308         print OUT "# dummy samples\n0 1 2 3\n1 1 2 3\n";
1309         &lr_sample(0,1,'offs');
1310         &lr_sample(1,1,'offs');
1311         &lr_sample(0,2,'freq');
1312         &lr_sample(1,2,'freq');
1313         @time = (0, 1); $maxtime = 1; $mintime = 0;
1314         @offs = (1, 1); $maxoffs = 1; $minoffs = 1;
1315         @freq = (2, 2); $maxfreq = 2; $minfreq = 2;
1316         @cmpl = (3, 3); $maxcmpl = 3; $mincmpl = 3;
1317         $LastCnt = 2;
1318         $LastFreqBase = 0;
1319         $LastCmplScale = 1;
1320         $LastTimeBase = 0;
1321         $miny = -$MinClip;
1322         $maxy = 3 + $MinClip;
1323     }
1324     close(OUT);
1325
1326     print "plot command input file created\n"
1327         if $verbose > 2;
1328
1329
1330     if (($fpos[$[] eq 'cnt' && scalar(@loffset) >= $cnt) ||
1331         ($fpos[$[] eq 'start' && $mintime <= $StartTime) ||
1332         ($fpos[$[] eq 'end'))
1333     {
1334         return ($fpos[$[],$filekey[$[],$loffset[$[]);
1335     }
1336     else                        # found to few lines - next time start search earlier in file
1337     {
1338         if ($fpos[$[] eq 'start')
1339         {
1340             ;# the timestamps we got for F_first and F_last guaranteed
1341             ;# that no file is left out
1342             ;# the only thing that could happen is:
1343             ;# we guessed the starting point wrong
1344             ;# compute a new guess from the first record found
1345             ;# if this equals our last guess use data of first record
1346             ;# otherwise try new guess
1347
1348             if ($fpos[$[+1] eq $filekey[$[] && $loffset[$[] > $fpos[$[+2])
1349             {
1350                 local($noff);
1351                 $noff = $loffset[$[] - ($cnt - @loffset + 1) * $RecordSize;
1352                 $noff = 0 if $noff < 0;
1353
1354                 return (@fpos[$[,$[+1], ($noff == $fpos[$[+2]) ? $loffset[$[] : $noff);
1355             }
1356             return ($fpos[$[],$filekey[$[],$loffset[$[]);
1357         }
1358         elsif ($fpos[$[] eq 'end' || $fpos[$[] eq 'cnt')
1359         {
1360             ;# try to start earlier in file
1361             ;# if we already started at the beginning
1362             ;# try to use previous file
1363             ;# this assumes distance to better starting point is at most one file
1364             ;# the primary guess at top of genfile() should usually allow this
1365             ;# assumption
1366             ;# if the offset of the first sample used is within
1367             ;# a different file than we guessed it must have occurred later
1368             ;# in the sequence of files
1369             ;# this only can happen if our starting file did not contain
1370             ;# a valid sample from the starting point we guessed
1371             ;# however this does not invalidate our assumption, no check needed
1372             local($noff,$key);
1373             if ($fpos[$[+2] > 0)
1374             {
1375                 $noff = $fpos[$[+2] - $RecordSize * ($cnt - @loffset + 1);
1376                 $noff = 0 if $noff < 0;
1377                 return (@fpos[$[,$[+1],$noff);
1378             }
1379             else
1380             {
1381                 if ($fpos[$[+1] eq $F_files[$[])
1382                 {
1383                     ;# first file - and not enough samples
1384                     ;# use data of first sample
1385                     return ($fpos[$[], $filekey[$[], $loffset[$[]);
1386                 }
1387                 else
1388                 {
1389                     ;# search key of previous file
1390                     $key = $F_files[$[];
1391                     @F = reverse(@F_files);
1392                     while ($_ = shift(@F))
1393                     {
1394                         if ($_ eq $fpos[$[+1])
1395                         {
1396                             $key = shift(@F) if @F;
1397                             last;
1398                         }
1399                     }
1400                     $noff = int($F_size{$key} / $RecordSize);
1401                     $noff -= $cnt - @loffset;
1402                     $noff = 0 if $noff < 0;
1403                     $noff *= $RecordSize;
1404                     return ($fpos[$[], $key, $noff);
1405                 }
1406             }
1407         }
1408         else
1409         {
1410             return ();
1411         }
1412
1413         return 0 if @loffset <= 1 || ($loffset[$#loffset] - $loffset[$[]) <= 1;
1414
1415         ;# EOF - 1.1 * avg(line) * $cnt
1416         local($val) =  $loffset[$#loffset]
1417             - $cnt * 11 * (($loffset[$#loffset] - $loffset[$[]) / @loffset) / 10;
1418         return ($val < 0) ? 0 : $val;
1419     }
1420 }
1421
1422 $Ltime = -1 if ! defined($Ltime);
1423 $LastFreqBase = 0;
1424 $LastFreqBaseString = "??";
1425
1426 ;# initial setup of plot
1427 print "initialize plotting\n" if $verbose;
1428 if (defined($PrintIt))
1429 {
1430   if ($PrintIt =~ m,/,)
1431   {
1432     print "Saving plot to file $PrintIt\n";
1433     print PLOT "set output '$PrintIt'\n";
1434   }
1435   else
1436   {
1437     print "Printing plot on printer $PrintIt\n";
1438     print PLOT "set output '| lpr -P$PrintIt -h'\n";
1439   }
1440   print PLOT "set terminal postscript landscape color solid 'Helvetica' 10\n";
1441 }
1442 print PLOT "set grid\n";
1443 print PLOT "set tics out\n";
1444 print PLOT "set format y '%g '\n";
1445 printf PLOT "set time 47\n" unless defined($PrintIt);
1446
1447 @filepos =();
1448 while(1)
1449 {
1450   print &ctime(time) if $verbose;
1451
1452   ;# update diplay characteristics
1453   &read_config;# unless defined($PrintIt);
1454
1455   unlink($tmpfile);
1456   @filepos = &genfile($samples,$srcprefix,$tmpfile,@filepos);
1457
1458   ;# make plotcmd display samples
1459   &make_doplot;
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 }
1464 continue
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
1490 sub 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
1653 sub min
1654 {
1655   local($m) = shift;
1656
1657   grep((($m > $_) && ($m = $_),0),@_);
1658   $m;
1659 }
1660
1661 sub max
1662 {
1663   local($m) = shift;
1664
1665   grep((($m < $_) && ($m = $_),0),@_);
1666   $m;
1667 }