perl/Geomag.pm

   1 #!/usr/bin/perl
   2 #
   3 # The geomagnetic information and calculation module
   4 #
   5 # Copyright (c) 1998 - Dirk Koopman G1TLH
   6 #
   7 # $Id$
   8 #
   9
  10 package Geomag;
  11
  12 use DXVars;
  13 use DXUtil;
  14 use DXLog;
  15 use Julian;
  16 use FileHandle;
  17 use Carp;
  18
  19 use strict;
  20 use vars qw($date $sfi $k $a $forecast @allowed @denied $fp $node $from);
  21
  22 $fp = 0;            # the DXLog fcb
  23 $date = 0;          # the unix time of the WWV (notional)
  24 $sfi = 0;           # the current SFI value
  25 $k = 0;             # the current K value
  26 $a = 0;             # the current A value
  27 $forecast = "";     # the current geomagnetic forecast
  28 $node = "";         # originating node
  29 $from = "";         # who this came from
  30 @allowed = ();      # if present only these callsigns are regarded as valid WWV updators
  31 @denied = ();       # if present ignore any wwv from these callsigns
  32 my $dirprefix = "$main::data/wwv";
  33 my $param = "$dirprefix/param";
  34
  35 sub init
  36 {
  37         $fp = DXLog::new('wwv', 'dat', 'm');
  38         mkdir $dirprefix, 0777 if !-e $dirprefix;        # now unnecessary DXLog will create it
  39         do "$param" if -e "$param";
  40         confess $@ if $@;
  41 }
  42
  43 # write the current data away
  44 sub store
  45 {
  46   my $fh = new FileHandle;
  47   open $fh, "> $param" or confess "can't open $param $!";
  48   print $fh "# Geomagnetic data parameter file last mod:", scalar gmtime, "\n";
  49   print $fh "\$date = $date;\n";
  50   print $fh "\$sfi = $sfi;\n";
  51   print $fh "\$a = $a;\n";
  52   print $fh "\$k = $k;\n";
  53   print $fh "\$from = '$from';\n";
  54   print $fh "\$node = '$node';\n";
  55   print $fh "\@denied = qw(", join(' ', @denied), ");\n" if @denied > 0;
  56   print $fh "\@allowed = qw(", join(' ', @allowed), ");\n" if @allowed > 0;
  57   close $fh;
  58
  59   # log it
  60   $fp->writeunix($date, "$from^$date^$sfi^$a^$k^$forecast^$node\n");
  61 }
  62
  63 # update WWV info in one go (usually from a PC23)
  64 sub update
  65 {
  66   my ($mydate, $mytime, $mysfi, $mya, $myk, $myforecast, $myfrom, $mynode) = @_;
  67   if ((@allowed && grep {$_ eq $from} @allowed) ||
  68       (@denied && !grep {$_ eq $from} @denied) ||
  69           (@allowed == 0 && @denied == 0)) {
  70
  71         my $trydate = cltounix($mydate, sprintf("%02d18Z", $mytime));
  72         if ($trydate >= $date) {
  73       $sfi = 0 + $mysfi;
  74       $k = 0 + $myk;
  75       $a = 0 + $mya;
  76       $forecast = $myforecast;
  77           $date = $trydate;
  78           $from = $myfrom;
  79           $node = $mynode;
  80
  81           store();
  82         }
  83   }
  84 }
  85
  86 # add or substract an allowed callsign
  87 sub allowed
  88 {
  89   my $flag = shift;
  90   if ($flag eq '+') {
  91     push @allowed, map {uc $_} @_;
  92   } else {
  93     my $c;
  94     foreach $c (@_) {
  95           @allowed = map {$_ ne uc $c} @allowed;
  96         }
  97   }
  98   store();
  99 }
 100
 101 # add or substract a denied callsign
 102 sub denied
 103 {
 104   my $flag = shift;
 105   if ($flag eq '+') {
 106     push @denied, map {uc $_} @_;
 107   } else {
 108     my $c;
 109     foreach $c (@_) {
 110           @denied = map {$_ ne uc $c} @denied;
 111         }
 112   }
 113   store();
 114 }
 115
 116 # accessor routines (when I work how symbolic refs work I might use one of those!)
 117 sub sfi
 118 {
 119   @_ ? $sfi = shift : $sfi ;
 120 }
 121
 122 sub k
 123 {
 124   @_ ? $k = shift : $k ;
 125 }
 126
 127 sub a
 128 {
 129   @_ ? $a = shift : $a ;
 130 }
 131
 132 sub forecast
 133 {
 134   @_ ? $forecast = shift : $forecast ;
 135 }
 136
 137 1;
 138 __END__;