![[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|
Return to ntploopwatch CVS log | Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / ntp / scripts / monitoring |
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: }