Annotation of embedaddon/ntp/scripts/monitoring/ntploopwatch, revision 1.1
1.1 ! misho 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:
! 21: undef($config);
! 22: undef($workdir);
! 23: undef($PrintIt);
! 24: undef($samples);
! 25: undef($StartTime);
! 26: undef($EndTime);
! 27: ($a,$b) if 0; # keep -w happy
! 28: $usage = <<"E-O-P";
! 29: usage:
! 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:
! 39: If 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:
! 52: If <printer> contains a '/' (slash character) output is directed to
! 53: a file of this name instead of delivered to a printer.
! 54: E-O-P
! 55:
! 56: ;# add directory to look for lr.pl and timelocal.pl (in front of current list)
! 57: unshift(@INC,".");
! 58:
! 59: require "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:
! 69: require "ctime.pl";
! 70: require "timelocal.pl";
! 71: ;# early distributions of ctime.pl had a bug
! 72: $ENV{'TZ'} = 'MET' unless defined $ENV{'TZ'} || $[ > 4.010;
! 73: if (defined(@ctime'MoY))
! 74: {
! 75: *Month=*ctime'MoY;
! 76: *Day=*ctime'DoW;
! 77: } # ' re-sync emacs fontification
! 78: else
! 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: }
! 83: print @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;
! 96: undef($timebase);
! 97: undef($freqbase);
! 98: undef($cmplscale);
! 99: undef($MaxY);
! 100: undef($MinY);
! 101: $deltaT = 512; # indicate sample data gaps greater than $deltaT seconds
! 102: $verbose = 1;
! 103:
! 104: while($_ = 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:
! 141: if (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:
! 149: if (!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
! 191: undef($laststat);
! 192:
! 193: ;# plot value ranges
! 194: undef($mintime);
! 195: undef($maxtime);
! 196: undef($minoffs);
! 197: undef($maxoffs);
! 198: undef($minfreq);
! 199: undef($maxfreq);
! 200: undef($mincmpl);
! 201: undef($maxcmpl);
! 202: undef($miny);
! 203: undef($maxy);
! 204:
! 205: ;# stop operation if plot command dies
! 206: sub 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:
! 221: sub 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: ;#
! 231: sub abs
! 232: {
! 233: ($_[$[] < 0) ? -($_[$[]) : $_[$[];
! 234: }
! 235:
! 236: sub 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:
! 248: print "starting plot command (" . join(" ",@plotcmd) . ")\n" if $verbose > 1;
! 249:
! 250: $Plotpid = open(PLOT,"|-");
! 251: select((select(PLOT),$|=1)[$[]); # make PLOT line bufferd
! 252:
! 253: defined($Plotpid) ||
! 254: die("$0: failed to start plot command: $!\n");
! 255:
! 256: unless ($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:
! 270: sub 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: }
! 437: print "configuration file read\n" if $verbose > 2;
! 438: }
! 439:
! 440: sub 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:
! 567: sub 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
! 1424: print "initialize plotting\n" if $verbose;
! 1425: if (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: }
! 1439: print PLOT "set grid\n";
! 1440: print PLOT "set tics out\n";
! 1441: print PLOT "set format y '%g '\n";
! 1442: printf PLOT "set time 47\n" unless defined($PrintIt);
! 1443:
! 1444: @filepos =();
! 1445: while(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: }
! 1464: continue
! 1465: {
! 1466: if (defined($PrintIt))
! 1467: {
! 1468: delete $SIG{'CHLD'};
! 1469: print PLOT "quit\n";
! 1470: close(PLOT);
! 1471: if ($PrintIt =~ m,/,)
! 1472: {
! 1473: print "Plot saved to file $PrintIt\n";
! 1474: }
! 1475: else
! 1476: {
! 1477: print "Plot spooled to printer $PrintIt\n";
! 1478: }
! 1479: unlink($tmpfile);
! 1480: exit(0);
! 1481: }
! 1482: ;# wait $delay seconds
! 1483: print "waiting $delay seconds ..." if $verbose > 2;
! 1484: sleep($delay);
! 1485: print " continuing\n" if $verbose > 2;
! 1486: undef($LastFreqBaseString);
! 1487: }
! 1488:
! 1489:
! 1490: sub date_time_spec2seconds
! 1491: {
! 1492: local($_) = @_;
! 1493: ;# a date_time_spec consistes of:
! 1494: ;# YYYY-MM-DD_HH:MM:SS.ms
! 1495: ;# values can be omitted from the beginning and default than to
! 1496: ;# values of current date
! 1497: ;# values omitted from the end default to lowest possible values
! 1498:
! 1499: local($time) = time;
! 1500: local($sec,$min,$hour,$mday,$mon,$year)
! 1501: = localtime($time);
! 1502:
! 1503: local($last) = ();
! 1504:
! 1505: s/^\D*(.*\d)\D*/$1/; # strip off garbage
! 1506:
! 1507: PARSE:
! 1508: {
! 1509: if (s/^(\d{4})(-|$)//)
! 1510: {
! 1511: if ($1 < 1970)
! 1512: {
! 1513: warn("$0: can not handle years before 1970 - year $1 ignored\n");
! 1514: return undef;
! 1515: }
! 1516: elsif ( $1 >= 2070)
! 1517: {
! 1518: warn("$0: can not handle years past 2070 - year $1 ignored\n");
! 1519: return undef;
! 1520: }
! 1521: else
! 1522: {
! 1523: $year = $1 % 100; # 0<= $year < 100
! 1524: ;# - interpreted 70 .. 99,00 .. 69
! 1525: }
! 1526: $last = $[ + 5;
! 1527: last PARSE if $_ eq '';
! 1528: warn("$0: bad date_time_spec: \"$_\" found after YEAR\n"),
! 1529: return(undef)
! 1530: if $2 eq '';
! 1531: }
! 1532:
! 1533: if (s/^(\d{1,2})(-|$)//)
! 1534: {
! 1535: warn("$0: implausible month $1\n"),return(undef)
! 1536: if $1 < 1 || $1 > 12;
! 1537: $mon = $1 - 1;
! 1538: $last = $[ + 4;
! 1539: last PARSE if $_ eq '';
! 1540: warn("$0: bad date_time_spec: \"$_\" found after MONTH\n"),
! 1541: return(undef)
! 1542: if $2 eq '';
! 1543: }
! 1544: else
! 1545: {
! 1546: warn("$0: bad date_time_spec \"$_\"\n"),return(undef)
! 1547: if defined($last);
! 1548:
! 1549: }
! 1550:
! 1551: if (s/^(\d{1,2})([_ ]|$)//)
! 1552: {
! 1553: warn("$0: implausible month day $1 for month ".($mon+1)." (".
! 1554: $MaxNumDaysPerMonth[$mon].")$mon\n"),
! 1555: return(undef)
! 1556: if $1 < 1 || $1 > $MaxNumDaysPerMonth[$mon];
! 1557: $mday = $1;
! 1558: $last = $[ + 3;
! 1559: last PARSE if $_ eq '';
! 1560: warn("$0: bad date_time_spec \"$_\" found after MDAY\n"),
! 1561: return(undef)
! 1562: if $2 eq '';
! 1563: }
! 1564: else
! 1565: {
! 1566: warn("$0: bad date_time_spec \"$_\"\n"), return undef
! 1567: if defined($last);
! 1568: }
! 1569:
! 1570: ;# now we face a problem:
! 1571: ;# if ! defined($last) a prefix of "07:"
! 1572: ;# can be either 07:MM or 07:ss
! 1573: ;# to get the second interpretation make the user add
! 1574: ;# a msec fraction part and check for this special case
! 1575: if (! defined($last) && s/^(\d{1,2}):(\d{1,2}\.\d+)//)
! 1576: {
! 1577: warn("$0: implausible minute $1\n"), return undef
! 1578: if $1 < 0 || $1 >= 60;
! 1579: warn("$0: implausible second $1\n"), return undef
! 1580: if $2 < 0 || $2 >= 60;
! 1581: $min = $1;
! 1582: $sec = $2;
! 1583: $last = $[ + 1;
! 1584: last PARSE if $_ eq '';
! 1585: warn("$0: bad date_time_spec \"$_\" after SECONDS\n");
! 1586: return undef;
! 1587: }
! 1588:
! 1589: if (s/^(\d{1,2})(:|$)//)
! 1590: {
! 1591: warn("$0: implausible hour $1\n"), return undef
! 1592: if $1 < 0 || $1 > 24;
! 1593: $hour = $1;
! 1594: $last = $[ + 2;
! 1595: last PARSE if $_ eq '';
! 1596: warn("$0: bad date_time_spec found \"$_\" after HOUR\n"),
! 1597: return undef
! 1598: if $2 eq '';
! 1599: }
! 1600: else
! 1601: {
! 1602: warn("$0: bad date_time_spec \"$_\"\n"), return undef
! 1603: if defined($last);
! 1604: }
! 1605:
! 1606: if (s/^(\d{1,2})(:|$)//)
! 1607: {
! 1608: warn("$0: implausible minute $1\n"), return undef
! 1609: if $1 < 0 || $1 >=60;
! 1610: $min = $1;
! 1611: $last = $[ + 1;
! 1612: last PARSE if $_ eq '';
! 1613: warn("$0: bad date_time_spec found \"$_\" after MINUTE\n"),
! 1614: return undef
! 1615: if $2 eq '';
! 1616: }
! 1617: else
! 1618: {
! 1619: warn("$0: bad date_time_spec \"$_\"\n"), return undef
! 1620: if defined($last);
! 1621: }
! 1622:
! 1623: if (s/^(\d{1,2}(\.\d+)?)//)
! 1624: {
! 1625: warn("$0: implausible second $1\n"), return undef
! 1626: if $1 < 0 || $1 >=60;
! 1627: $sec = $1;
! 1628: $last = $[;
! 1629: last PARSE if $_ eq '';
! 1630: warn("$0: bad date_time_spec found \"$_\" after SECOND\n");
! 1631: return undef;
! 1632: }
! 1633: }
! 1634:
! 1635: return $time unless defined($last);
! 1636:
! 1637: $sec = 0 if $last > $[;
! 1638: $min = 0 if $last > $[ + 1;
! 1639: $hour = 0 if $last > $[ + 2;
! 1640: $mday = 1 if $last > $[ + 3;
! 1641: $mon = 0 if $last > $[ + 4;
! 1642: local($rtime) = &timelocal($sec,$min,$hour,$mday,$mon,$year, 0,0, 0);
! 1643:
! 1644: ;# $rtime may be off if daylight savings time is in effect at given date
! 1645: return $rtime + ($sec - int($sec))
! 1646: if $hour == (localtime($rtime))[$[+2];
! 1647: return
! 1648: &timelocal($sec,$min,$hour,$mday,$mon,$year, 0,0, 1)
! 1649: + ($sec - int($sec));
! 1650: }
! 1651:
! 1652:
! 1653: sub min
! 1654: {
! 1655: local($m) = shift;
! 1656:
! 1657: grep((($m > $_) && ($m = $_),0),@_);
! 1658: $m;
! 1659: }
! 1660:
! 1661: sub max
! 1662: {
! 1663: local($m) = shift;
! 1664:
! 1665: grep((($m < $_) && ($m = $_),0),@_);
! 1666: $m;
! 1667: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ntploopwatch CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / ntp / scripts / monitoring