/contrib/ntp/scripts/monitoring/ntploopwatch
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}