3 # The WCY analog of the WWV geomagnetic information and calculation module
5 # Copyright (c) 2000 - Dirk Koopman G1TLH
22 use vars qw($date $sfi $k $expk $a $r $sa $gmf $au @allowed @denied $fp $node $from
24 $duplth $dupage $filterdef);
26 $fp = 0; # the DXLog fcb
27 $date = 0; # the unix time of the WWV (notional)
28 $sfi = 0; # the current SFI value
29 $k = 0; # the current K value
30 $a = 0; # the current A value
31 $r = 0; # the current R value
32 $sa = ""; # solar activity
33 $gmf = ""; # Geomag activity
34 $au = 'no'; # aurora warning
35 $node = ""; # originating node
36 $from = ""; # who this came from
37 @allowed = qw(DK0WCY); # if present only these callsigns are regarded as valid WWV updators
38 @denied = (); # if present ignore any wwv from these callsigns
39 $duplth = 20; # the length of text to use in the deduping
40 $dupage = 12*3600; # the length of time to hold spot dups
42 $dirprefix = "$main::local_data/wcy";
43 $param = "$dirprefix/param";
50 # tag, sort, field, priv, special parser
54 ['by_dxcc', 'nc', 14],
56 ['by_zone', 'nz', 16],
57 ['origin_dxcc', 'nc', 17],
58 ['origin_itu', 'ni', 18],
59 ['origin_zone', 'nz', 19],
64 $fp = DXLog::new('wcy', 'dat', 'm');
65 do "$param" if -e "$param";
66 # read in existing data
67 @cache = readfile($main::systime);
68 shift @cache while @cache > $maxcache;
69 dbg(sprintf "WCY read in last %d records into cache", scalar @cache);
73 # write the current data away
76 my $fh = new IO::File;
77 open $fh, "> $param" or confess "can't open $param $!";
78 print $fh "# WCY data parameter file last mod:", scalar gmtime, "\n";
79 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)]);
83 $fh->print($dd->Dumpxs);
87 my $s = "$date^$sfi^$a^$k^$expk^$r^$sa^$gmf^$au^$from^$node";
88 $fp->writeunix($date, $s);
89 push @cache, [ split /\^/, $s ];
90 shift @cache while @cache > $maxcache;
93 # update WCY info in one go (usually from a PC23)
96 my ($mydate, $mytime, $mysfi, $mya, $myk, $myexpk, $myr, $mysa, $mygmf, $myau, $myfrom, $mynode) = @_;
98 if ((@allowed && grep {$_ eq $myfrom} @allowed) ||
99 (@denied && !grep {$_ eq $myfrom} @denied) ||
100 (@allowed == 0 && @denied == 0)) {
102 # my $trydate = cltounix($mydate, sprintf("%02d18Z", $mytime));
103 if ($mydate >= $date) {
107 $r = 0 unless abs ($mysfi - $sfi) > 3;
126 # add or substract an allowed callsign
131 push @allowed, map {uc $_} @_;
135 @allowed = map {$_ ne uc $c} @allowed;
141 # add or substract a denied callsign
146 push @denied, map {uc $_} @_;
150 @denied = map {$_ ne uc $c} @denied;
157 # print some items from the log backwards in time
159 # This command outputs a list of n lines starting from line $from to $to
166 my $date = $fp->unixtoj($t);
174 if ($t == $main::systime && ($to <= $maxcache)) {
175 dbg("using wcy cache") if isdbg('wcy');
176 @out = reverse @cache;
177 pop @out while @out > $to;
179 dbg("using wwv file(s))") if isdbg('wwv');
184 for (\$c = \$#in; \$c >= 0; \$c--) {
188 next if \$count < \$from;
190 last if \$count >= \$to; # stop after n
195 $fp->close; # close any open files
196 my $fh = $fp->open($date);
197 for ($i = $count = 0; $count < $to; $i++ ) {
202 push @in, [ split '\^' ] if length > 2;
204 eval $eval; # do the search on this file
205 return ("Geomag search error", $@) if $@;
206 last if $count >= $to; # stop after n
208 $fh = $fp->openprev(); # get the next file
217 # the standard log printing interpreting routine.
219 # every line that is printed should call this routine to be actually visualised
221 # Don't really know whether this is the correct place to put this stuff, but where
224 # I get a reference to an array of items
229 my $d = cldate($r->[0]);
230 my $t = (gmtime($r->[0]))[2];
232 return sprintf("$d %02d %5d %3d %3d %3d %3d %-5s %-5s %6s <%s>",
237 # read in this month's data
241 my $date = $fp->unixtoj(shift);
242 my $fh = $fp->open($date);
249 push @in, [ split '\^' ] if length > 2;
255 # enter the spot for dup checking and return true if it is already a dup
261 return 2 if $d < $main::systime - $dupage;
264 return DXDupe::check($dupkey, $main::systime+$dupage);
269 return DXDupe::listdups('C', $dupage, @_);