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