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";
46 # tag, sort, field, priv, special parser
50 ['by_dxcc', 'nc', 14],
52 ['by_zone', 'nz', 16],
53 ['origin_dxcc', 'nc', 17],
54 ['origin_itu', 'ni', 18],
55 ['origin_zone', 'nz', 19],
60 $fp = DXLog::new('wcy', 'dat', 'm');
61 do "$param" if -e "$param";
65 # write the current data away
68 my $fh = new IO::File;
69 open $fh, "> $param" or confess "can't open $param $!";
70 print $fh "# WCY data parameter file last mod:", scalar gmtime, "\n";
71 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)]);
75 $fh->print($dd->Dumpxs);
79 $fp->writeunix($date, "$date^$sfi^$a^$k^$expk^$r^$sa^$gmf^$au^$from^$node");
82 # update WWV info in one go (usually from a PC23)
85 my ($mydate, $mytime, $mysfi, $mya, $myk, $myexpk, $myr, $mysa, $mygmf, $myau, $myfrom, $mynode) = @_;
87 if ((@allowed && grep {$_ eq $myfrom} @allowed) ||
88 (@denied && !grep {$_ eq $myfrom} @denied) ||
89 (@allowed == 0 && @denied == 0)) {
91 # my $trydate = cltounix($mydate, sprintf("%02d18Z", $mytime));
92 if ($mydate >= $date) {
96 $r = 0 unless abs ($mysfi - $sfi) > 3;
115 # add or substract an allowed callsign
120 push @allowed, map {uc $_} @_;
124 @allowed = map {$_ ne uc $c} @allowed;
130 # add or substract a denied callsign
135 push @denied, map {uc $_} @_;
139 @denied = map {$_ ne uc $c} @denied;
146 # print some items from the log backwards in time
148 # This command outputs a list of n lines starting from line $from to $to
154 my $date = $fp->unixtoj(shift);
166 for (\$c = \$#in; \$c >= 0; \$c--) {
170 next if \$count < \$from;
172 last if \$count >= \$to; # stop after n
177 $fp->close; # close any open files
178 my $fh = $fp->open($date);
179 for ($i = $count = 0; $count < $to; $i++ ) {
184 push @in, [ split '\^' ] if length > 2;
186 eval $eval; # do the search on this file
187 return ("Geomag search error", $@) if $@;
188 last if $count >= $to; # stop after n
190 $fh = $fp->openprev(); # get the next file
198 # the standard log printing interpreting routine.
200 # every line that is printed should call this routine to be actually visualised
202 # Don't really know whether this is the correct place to put this stuff, but where
205 # I get a reference to an array of items
210 my $d = cldate($r->[0]);
211 my $t = (gmtime($r->[0]))[2];
213 return sprintf("$d %02d %5d %3d %3d %3d %3d %-5s %-5s %6s <%s>",
218 # read in this month's data
222 my $date = $fp->unixtoj(shift);
223 my $fh = $fp->open($date);
230 push @in, [ split '\^' ] if length > 2;
236 # enter the spot for dup checking and return true if it is already a dup
242 return 2 if $d < $main::systime - $dupage;
245 return DXDupe::check($dupkey, $main::systime+$dupage);
250 return DXDupe::listdups('C', $dupage, @_);