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::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],
61 $fp = DXLog::new('wcy', 'dat', 'm');
62 do "$param" if -e "$param";
66 # write the current data away
69 my $fh = new IO::File;
70 open $fh, "> $param" or confess "can't open $param $!";
71 print $fh "# WCY data parameter file last mod:", scalar gmtime, "\n";
72 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)]);
76 $fh->print($dd->Dumpxs);
80 $fp->writeunix($date, "$date^$sfi^$a^$k^$expk^$r^$sa^$gmf^$au^$from^$node");
83 # update WWV info in one go (usually from a PC23)
86 my ($mydate, $mytime, $mysfi, $mya, $myk, $myexpk, $myr, $mysa, $mygmf, $myau, $myfrom, $mynode) = @_;
88 if ((@allowed && grep {$_ eq $myfrom} @allowed) ||
89 (@denied && !grep {$_ eq $myfrom} @denied) ||
90 (@allowed == 0 && @denied == 0)) {
92 # my $trydate = cltounix($mydate, sprintf("%02d18Z", $mytime));
93 if ($mydate >= $date) {
97 $r = 0 unless abs ($mysfi - $sfi) > 3;
116 # add or substract an allowed callsign
121 push @allowed, map {uc $_} @_;
125 @allowed = map {$_ ne uc $c} @allowed;
131 # add or substract a denied callsign
136 push @denied, map {uc $_} @_;
140 @denied = map {$_ ne uc $c} @denied;
147 # print some items from the log backwards in time
149 # This command outputs a list of n lines starting from line $from to $to
155 my $date = $fp->unixtoj(shift);
167 for (\$c = \$#in; \$c >= 0; \$c--) {
171 next if \$count < \$from;
173 last if \$count >= \$to; # stop after n
178 $fp->close; # close any open files
179 my $fh = $fp->open($date);
180 for ($i = $count = 0; $count < $to; $i++ ) {
185 push @in, [ split '\^' ] if length > 2;
187 eval $eval; # do the search on this file
188 return ("Geomag search error", $@) if $@;
189 last if $count >= $to; # stop after n
191 $fh = $fp->openprev(); # get the next file
199 # the standard log printing interpreting routine.
201 # every line that is printed should call this routine to be actually visualised
203 # Don't really know whether this is the correct place to put this stuff, but where
206 # I get a reference to an array of items
211 my $d = cldate($r->[0]);
212 my $t = (gmtime($r->[0]))[2];
214 return sprintf("$d %02d %5d %3d %3d %3d %3d %-5s %-5s %6s <%s>",
219 # read in this month's data
223 my $date = $fp->unixtoj(shift);
224 my $fh = $fp->open($date);
231 push @in, [ split '\^' ] if length > 2;
237 # enter the spot for dup checking and return true if it is already a dup
243 return 2 if $d < $main::systime - $dupage;
246 return DXDupe::check($dupkey, $main::systime+$dupage);
251 return DXDupe::listdups('C', $dupage, @_);