source: trunk/third/xntp/scripts/monitoring/ntploopwatch @ 10832

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