]> dxcluster.org Git - spider.git/blob - perl/Geomag.pm
1. Do some range checking for spots and WWV in the future (got a WWV for Oct
[spider.git] / perl / Geomag.pm
1 #!/usr/bin/perl
2
3 # The geomagnetic information and calculation module
4 # a chanfe
5 #
6 # Copyright (c) 1998 - Dirk Koopman G1TLH
7 #
8 # $Id$
9 #
10
11 package Geomag;
12
13 use DXVars;
14 use DXUtil;
15 use DXLog;
16 use Julian;
17 use FileHandle;
18 use Carp;
19
20 use strict;
21 use vars qw($date $sfi $k $a $forecast @allowed @denied $fp $node $from);
22
23 $fp = 0;                                                # the DXLog fcb
24 $date = 0;                                              # the unix time of the WWV (notional)
25 $sfi = 0;                                               # the current SFI value
26 $k = 0;                                                 # the current K value
27 $a = 0;                                                 # the current A value
28 $forecast = "";                                 # the current geomagnetic forecast
29 $node = "";                                             # originating node
30 $from = "";                                             # who this came from
31 @allowed = ();                                  # if present only these callsigns are regarded as valid WWV updators
32 @denied = ();                                   # if present ignore any wwv from these callsigns
33 my $dirprefix = "$main::data/wwv";
34 my $param = "$dirprefix/param";
35
36 sub init
37 {
38         $fp = DXLog::new('wwv', 'dat', 'm');
39         mkdir $dirprefix, 0777 if !-e $dirprefix; # now unnecessary DXLog will create it
40         do "$param" if -e "$param";
41         confess $@ if $@;
42 }
43
44 # write the current data away
45 sub store
46 {
47         my $fh = new FileHandle;
48         open $fh, "> $param" or confess "can't open $param $!";
49         print $fh "# Geomagnetic data parameter file last mod:", scalar gmtime, "\n";
50         print $fh "\$date = $date;\n";
51         print $fh "\$sfi = $sfi;\n";
52         print $fh "\$a = $a;\n";
53         print $fh "\$k = $k;\n";
54         print $fh "\$from = '$from';\n";
55         print $fh "\$node = '$node';\n";
56         print $fh "\@denied = qw(", join(' ', @denied), ");\n" if @denied > 0;
57         print $fh "\@allowed = qw(", join(' ', @allowed), ");\n" if @allowed > 0;
58         close $fh;
59         
60         # log it
61         $fp->writeunix($date, "$from^$date^$sfi^$a^$k^$forecast^$node");
62 }
63
64 # update WWV info in one go (usually from a PC23)
65 sub update
66 {
67         my ($mydate, $mytime, $mysfi, $mya, $myk, $myforecast, $myfrom, $mynode) = @_;
68         if ((@allowed && grep {$_ eq $from} @allowed) || 
69                 (@denied && !grep {$_ eq $from} @denied) ||
70                 (@allowed == 0 && @denied == 0)) {
71                 
72                 #       my $trydate = cltounix($mydate, sprintf("%02d18Z", $mytime));
73                 if ($mydate >= $date) {
74                         $sfi = 0 + $mysfi;
75                         $k = 0 + $myk;
76                         $a = 0 + $mya;
77                         $forecast = $myforecast;
78                         $date = $mydate;
79                         $from = $myfrom;
80                         $node = $mynode;
81                         
82                         store();
83                 }
84         }
85 }
86
87 # add or substract an allowed callsign
88 sub allowed
89 {
90         my $flag = shift;
91         if ($flag eq '+') {
92                 push @allowed, map {uc $_} @_;
93         } else {
94                 my $c;
95                 foreach $c (@_) {
96                         @allowed = map {$_ ne uc $c} @allowed; 
97                 } 
98         }
99         store();
100 }
101
102 # add or substract a denied callsign
103 sub denied
104 {
105         my $flag = shift;
106         if ($flag eq '+') {
107                 push @denied, map {uc $_} @_;
108         } else {
109                 my $c;
110                 foreach $c (@_) {
111                         @denied = map {$_ ne uc $c} @denied; 
112                 } 
113         }
114         store();
115 }
116
117 # accessor routines (when I work how symbolic refs work I might use one of those!)
118 sub sfi
119 {
120         @_ ? $sfi = shift : $sfi ;
121 }
122
123 sub k
124 {
125         @_ ? $k = shift : $k ;
126 }
127
128 sub a
129 {
130         @_ ? $a = shift : $a ;
131 }
132
133 sub forecast
134 {
135         @_ ? $forecast = shift : $forecast ;
136 }
137
138 #
139 # print some items from the log backwards in time
140 #
141 # This command outputs a list of n lines starting from line $from to $to
142 #
143 sub search
144 {
145         my $from = shift;
146         my $to = shift;
147         my @date = $fp->unixtoj(shift);
148         my $pattern = shift;
149         my $search;
150         my @out;
151         my $eval;
152         my $count;
153         
154         $search = 1;
155         $eval = qq(
156                            my \$c;
157                            my \$ref;
158                            for (\$c = \$        #in; \$c >= 0; \$c--) {
159                                         \$ref = \$in[\$c];
160                                         if ($search) {
161                                                 \$count++;
162                                                 next if \$count < \$from;
163                                                 push \@out, \$ref;
164                                                 last if \$count >= \$to; # stop after n
165                                         }
166                                 }
167                           );
168         
169         $fp->close;                                     # close any open files
170         
171         my $fh = $fp->open(@date); 
172         for ($count = 0; $count < $to; ) {
173                 my @in = ();
174                 if ($fh) {
175                         while (<$fh>) {
176                                 chomp;
177                                 push @in, [ split '\^' ] if length > 2;
178                         }
179                         eval $eval;                     # do the search on this file
180                         return ("Geomag search error", $@) if $@;
181                         last if $count >= $to; # stop after n
182                 }
183                 $fh = $fp->openprev();  # get the next file
184                 last if !$fh;
185         }
186         
187         return @out;
188 }
189
190 #
191 # the standard log printing interpreting routine.
192 #
193 # every line that is printed should call this routine to be actually visualised
194 #
195 # Don't really know whether this is the correct place to put this stuff, but where
196 # else is correct?
197 #
198 # I get a reference to an array of items
199 #
200 sub print_item
201 {
202         my $r = shift;
203         my @ref = @$r;
204         my $d = cldate($ref[1]);
205         my ($t) = (gmtime($ref[1]))[2];
206         
207         return sprintf("$d   %02d %5d %3d %3d %-37s <%s>", $t, $ref[2], $ref[3], $ref[4], $ref[5], $ref[0]);
208 }
209
210 #
211 # read in this month's data
212 #
213 sub readfile
214 {
215         my @date = $fp->unixtoj(shift);
216         my $fh = $fp->open(@date); 
217         my @spots = ();
218         my @in;
219         
220         if ($fh) {
221                 while (<$fh>) {
222                         chomp;
223                         push @in, [ split '\^' ] if length > 2;
224                 }
225         }
226         return @in;
227 }
228 1;
229 __END__;