PageRenderTime 35ms CodeModel.GetById 14ms app.highlight 10ms RepoModel.GetById 1ms app.codeStats 1ms

/contrib/ntp/scripts/monitoring/ntploopwatch

https://bitbucket.org/freebsd/freebsd-head/
Perl | 1667 lines | 1488 code | 178 blank | 1 comment | 380 complexity | 92196014613481fd3c16a6d93a701023 MD5 | raw file
   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}