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