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