/contrib/ntp/scripts/monitoring/ntploopwatch

https://bitbucket.org/freebsd/freebsd-head/ · Perl · 1667 lines · 1488 code · 178 blank · 1 comment · 377 complexity · 92196014613481fd3c16a6d93a701023 MD5 · raw file

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