]> scm.dxcluster.org Git - spider.git/blob - perl/Geomag.pm
a63d19b66bbdef6d473e19b0a675eedd802c11a9
[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 ($trydate >= $date) {
74       $sfi = 0 + $mysfi;
75       $k = 0 + $myk;
76       $a = 0 + $mya;
77       $forecast = $myforecast;
78           $date = $trydate;
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 print
144 {
145         my $self = $fp;
146         my $from = shift;
147         my $to = shift;
148         my @date = $self->unixtoj(shift);
149         my $pattern = shift;
150         my $search;
151         my @in;
152         my @out;
153         my $eval;
154         my $count;
155             
156         $search = 1;
157         $eval = qq(
158                            my \$c;
159                            my \$ref;
160                            for (\$c = \$#in; \$c >= 0; \$c--) {
161                                         \$ref = \$in[\$c];
162                                         if ($search) {
163                                                 \$count++;
164                                                 next if \$count < $from;
165                                                 push \@out, print_item(\$ref);
166                                                 last LOOP if \$count >= \$to;                  # stop after n
167                                         }
168                                 }
169                           );
170         
171         $self->close;                                      # close any open files
172
173         my $fh = $self->open(@date); 
174 LOOP:
175         while ($count < $to) {
176                 my @spots = ();
177                 if ($fh) {
178                         while (<$fh>) {
179                                 chomp;
180                                 push @in, [ split '\^' ] if length > 2;
181                         }
182                         eval $eval;               # do the search on this file
183                         return ("Spot search error", $@) if $@;
184                 }
185                 $fh = $self->openprev();      # get the next file
186                 last if !$fh;
187         }
188
189         return @out;
190 }
191
192 #
193 # the standard log printing interpreting routine.
194 #
195 # every line that is printed should call this routine to be actually visualised
196 #
197 # Don't really know whether this is the correct place to put this stuff, but where
198 # else is correct?
199 #
200 # I get a reference to an array of items
201 #
202 sub print_item
203 {
204         my $r = shift;
205         my @ref = @$r;
206         my $d = cldate($ref[1]);
207         my ($t) = (gmtime($ref[1]))[2];
208
209         return sprintf("$d   %02d %5d %3d %3d %-37s <%s>", $t, $ref[2], $ref[3], $ref[4], $ref[5], $ref[0]);
210 }
211
212 1;
213 __END__;