3 # The WCY analog of the WWV geomagnetic information and calculation module
5 # Copyright (c) 2000 - Dirk Koopman G1TLH
19 use Time::HiRes qw(gettimeofday tv_interval);
23 use vars qw($date $sfi $k $expk $a $r $sa $gmf $au @allowed @denied $fp $node $from
25 $duplth $dupage $filterdef);
27 $fp = 0; # the DXLog fcb
28 $date = 0; # the unix time of the WWV (notional)
29 $sfi = 0; # the current SFI value
30 $k = 0; # the current K value
31 $a = 0; # the current A value
32 $r = 0; # the current R value
33 $sa = ""; # solar activity
34 $gmf = ""; # Geomag activity
35 $au = 'no'; # aurora warning
36 $node = ""; # originating node
37 $from = ""; # who this came from
38 @allowed = qw(DK0WCY); # if present only these callsigns are regarded as valid WWV updators
39 @denied = (); # if present ignore any wwv from these callsigns
40 $duplth = 20; # the length of text to use in the deduping
41 $dupage = 12*3600; # the length of time to hold spot dups
43 $dirprefix = "$main::local_data/wcy";
44 $param = "$dirprefix/param";
51 # tag, sort, field, priv, special parser
55 ['by_dxcc', 'nc', 14],
57 ['by_zone', 'nz', 16],
58 ['origin_dxcc', 'nc', 17],
59 ['origin_itu', 'ni', 18],
60 ['origin_zone', 'nz', 19],
65 $fp = DXLog::new('wcy', 'dat', 'm');
66 do "$param" if -e "$param";
67 # read in existing data
68 my $t0 = [gettimeofday];
69 @cache = readfile($main::systime);
70 shift @cache while @cache > $maxcache;
71 dbg(sprintf "WCY read in last %d records into cache %dmS", scalar @cache, _diffms($t0));
75 # write the current data away
78 my $fh = new IO::File;
79 open $fh, "> $param" or confess "can't open $param $!";
80 print $fh "# WCY data parameter file last mod:", scalar gmtime, "\n";
81 my $dd = new Data::Dumper([ $date, $sfi, $a, $k, $expk, $r, $sa, $gmf, $au, $from, $node, \@denied, \@allowed ], [qw(date sfi a k expk r sa gmf au from node *denied *allowed)]);
85 $fh->print($dd->Dumpxs);
89 my $s = "$date^$sfi^$a^$k^$expk^$r^$sa^$gmf^$au^$from^$node";
90 $fp->writeunix($date, $s);
91 push @cache, [ split /\^/, $s ];
92 shift @cache while @cache > $maxcache;
95 # update WCY info in one go (usually from a PC23)
98 my ($mydate, $mytime, $mysfi, $mya, $myk, $myexpk, $myr, $mysa, $mygmf, $myau, $myfrom, $mynode) = @_;
100 if ((@allowed && grep {$_ eq $myfrom} @allowed) ||
101 (@denied && !grep {$_ eq $myfrom} @denied) ||
102 (@allowed == 0 && @denied == 0)) {
104 # my $trydate = cltounix($mydate, sprintf("%02d18Z", $mytime));
105 if ($mydate >= $date) {
109 $r = 0 unless abs ($mysfi - $sfi) > 3;
128 # add or substract an allowed callsign
133 push @allowed, map {uc $_} @_;
137 @allowed = map {$_ ne uc $c} @allowed;
143 # add or substract a denied callsign
148 push @denied, map {uc $_} @_;
152 @denied = map {$_ ne uc $c} @denied;
159 # print some items from the log backwards in time
161 # This command outputs a list of n lines starting from line $from to $to
168 my $date = $fp->unixtoj($t);
176 if ($t == $main::systime && ($to && $to <= @cache)) {
177 dbg("using wcy cache") if isdbg('wcy');
178 @out = reverse @cache;
179 pop @out while @out > $to;
181 dbg("using wwv file(s))") if isdbg('wwv');
186 for (\$c = \$#in; \$c >= 0; \$c--) {
190 next if \$count < \$from;
192 last if \$count >= \$to; # stop after n
197 $fp->close; # close any open files
198 my $fh = $fp->open($date);
199 for ($i = $count = 0; $count < $to; $i++ ) {
204 push @in, [ split '\^' ] if length > 2;
206 eval $eval; # do the search on this file
207 return ("Geomag search error", $@) if $@;
208 last if $count >= $to; # stop after n
210 $fh = $fp->openprev(); # get the next file
219 # the standard log printing interpreting routine.
221 # every line that is printed should call this routine to be actually visualised
223 # Don't really know whether this is the correct place to put this stuff, but where
226 # I get a reference to an array of items
231 my $d = cldate($r->[0]);
232 my $t = (gmtime($r->[0]))[2];
234 return sprintf("$d %02d %5d %3d %3d %3d %3d %-5s %-5s %6s <%s>",
239 # read in this month's data
243 my $date = $fp->unixtoj(shift);
244 my $fh = $fp->open($date);
251 push @in, [ split '\^' ] if length > 2;
257 # enter the spot for dup checking and return true if it is already a dup
263 return 2 if $d < $main::systime - $dupage;
266 return DXDupe::check($dupkey, $main::systime+$dupage);
271 return DXDupe::listdups('C', $dupage, @_);