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__;