added DK0WCY-3 WWV announce beacon parsing into local WWV file

diff --git a/Changes b/Changes
index acfddda82121991d05153fa3421f7198943d33b9..0cec4e69eebc34909b69eaccbe595eba0a317b01 100644 (file)
--- a/Changes
+++ b/Changes
@@ -4,6 +4,8 @@
 (def 72)
 3. help command should now return stuff that you expect.
 4. reduced necessary privilege to use 'MSG' command to 6.
 (def 72)
 3. help command should now return stuff that you expect.
 4. reduced necessary privilege to use 'MSG' command to 6.

+5. Correct the count of spots and wwv for a merge.
+6. Allow decodes of DK0WCY-3 WWV data beacon announces

 18Oct99=======================================================================
 1. changed help command so that it works correctly with multiple title lines.
 2. added to address to the list of things a message checks to see whether it
 18Oct99=======================================================================
 1. changed help command so that it works correctly with multiple title lines.
 2. added to address to the list of things a message checks to see whether it

diff --git a/perl/Console.pm b/perl/Console.pm
index 453cf97db2a6e36824a8c4bce9fdc53da61e6f47..052d1073a01ccf67f41d599ff0fc02449eecc06b 100644 (file)
--- a/perl/Console.pm
+++ b/perl/Console.pm
@@ -30,7 +30,7 @@ if ($ENV{'TERM'} =~ /(xterm|ansi)/) {
        $foreground = COLOR_BLACK();
        $background = COLOR_WHITE();
        @colors = (
        $foreground = COLOR_BLACK();
        $background = COLOR_WHITE();
        @colors = (

-                  [ '^DX de [\-A-Z0-9]+:\s+(14[45]\d\d\d|5[01]\d\d\d)', COLOR_PAIR(1) ],
+                  [ '^DX de [\-A-Z0-9]+:\s+([57][01]\d\d\d\.|\d\d\d\d\d\d+.)', COLOR_PAIR(1) ],

                   [ '^DX', COLOR_PAIR(5) ],
                   [ '^To', COLOR_PAIR(3) ],
                   [ '^WWV', COLOR_PAIR(4) ],
                   [ '^DX', COLOR_PAIR(5) ],
                   [ '^To', COLOR_PAIR(3) ],
                   [ '^WWV', COLOR_PAIR(4) ],


@@ -44,7 +44,7 @@ if ($ENV{'TERM'} =~ /(console|linux)/) {
        $foreground = COLOR_WHITE();
        $background = COLOR_BLACK();
        @colors = (
        $foreground = COLOR_WHITE();
        $background = COLOR_BLACK();
        @colors = (

-                  [ '^DX de [\-\w]+:\s+(14[45]\d\d\d|5[01]\d\d\d)', COLOR_PAIR(1) ],
+                  [ '^DX de [\-A-Z0-9]+:\s+([57][01]\d\d\d\.|\d\d\d\d\d\d+.)', COLOR_PAIR(1) ],

                   [ '^DX', COLOR_PAIR(4) ],
                   [ '^To', COLOR_PAIR(3) ],
                   [ '^WWV', COLOR_PAIR(5) ],
                   [ '^DX', COLOR_PAIR(4) ],
                   [ '^To', COLOR_PAIR(3) ],
                   [ '^WWV', COLOR_PAIR(5) ],

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index caa01789bab372380a05bdee908c6ce1f0a7e3fa..6d2a7231063393a50cbe608f7a0565187810978b 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -31,9 +31,10 @@ use strict;
 use vars qw($me $pc11_max_age $pc23_max_age $pc11_dup_age $pc23_dup_age
                        %spotdup %wwvdup $last_hour %pings %rcmds
                        %nodehops @baddx $baddxfn $pc12_dup_age
 use vars qw($me $pc11_max_age $pc23_max_age $pc11_dup_age $pc23_dup_age
                        %spotdup %wwvdup $last_hour %pings %rcmds
                        %nodehops @baddx $baddxfn $pc12_dup_age

-                       %anndup $allowzero $pc12_dup_lth);
+                       %anndup $allowzero $pc12_dup_lth $decode_dk0wcy);

 
 $me = undef;                                   # the channel id for this cluster
 
 $me = undef;                                   # the channel id for this cluster

+$decode_dk0wcy = undef;                        # if set use this callsign to decode announces from the EU WWV data beacon

 $pc11_max_age = 1*3600;                        # the maximum age for an incoming 'real-time' pc11
 $pc23_max_age = 1*3600;                        # the maximum age for an incoming 'real-time' pc23
 $pc11_dup_age = 24*3600;               # the maximum time to keep the spot dup list for
 $pc11_max_age = 1*3600;                        # the maximum age for an incoming 'real-time' pc11
 $pc23_max_age = 1*3600;                        # the maximum age for an incoming 'real-time' pc23
 $pc11_dup_age = 24*3600;               # the maximum time to keep the spot dup list for


@@ -270,7 +271,7 @@ sub normal
                        }
                        $anndup{$dupkey} = $main::systime;
                        
                        }
                        $anndup{$dupkey} = $main::systime;
                        

-                       # global ann filtering
+                       # global ann filtering on INPUT

                        my ($filter, $hops) = Filter::it($self->{annfilter}, @field[1..6], $self->{call} ) if $self->{annfilter};
                        if ($self->{annfilter} && !$filter) {
                                dbg('chan', "Rejected by filter");
                        my ($filter, $hops) = Filter::it($self->{annfilter}, @field[1..6], $self->{call} ) if $self->{annfilter};
                        if ($self->{annfilter} && !$filter) {
                                dbg('chan', "Rejected by filter");


@@ -306,6 +307,11 @@ sub normal
                                }
                                Log('ann', $target, $field[1], $text);
                                
                                }
                                Log('ann', $target, $field[1], $text);
                                

+                               if ($decode_dk0wcy && $field[1] eq $decode_dk0wcy) {
+                                       my ($hour, $k, $next, $a, $r, $sfi) = $field[3] =~ /^Aurora Beacon\s+(\d+)UTC,\s+Kiel\s+K=(\d+),.*ed\s+K=(\d+),\s+A=(\d+),\s+R=(\d+),\s+SFI=(\d+),/;
+                                       my $wwv = Geomag::update($main::systime, $hour, $sfi, $a, $k, "R=$r, Next K=$next", $decode_dk0wcy, $field[5], $r);
+                               }
+                               

                                return if $field[2] eq $main::mycall; # it's routed to me
                        } else {
                                route($field[2], $line);
                                return if $field[2] eq $main::mycall; # it's routed to me
                        } else {
                                route($field[2], $line);


@@ -509,26 +515,27 @@ sub normal
                        my $sfi = unpad($field[3]);
                        my $k = unpad($field[4]);
                        my $i = unpad($field[5]);
                        my $sfi = unpad($field[3]);
                        my $k = unpad($field[4]);
                        my $i = unpad($field[5]);

+                       my $r = $field[6] =~ /R=(\d+)/ || 0;

                        my $dupkey = "$d.$sfi$k$i";
                        if ($wwvdup{$dupkey}) {
                                dbg('chan', "Dup WWV Spot ignored\n");
                                return;
                        }
                        my $dupkey = "$d.$sfi$k$i";
                        if ($wwvdup{$dupkey}) {
                                dbg('chan', "Dup WWV Spot ignored\n");
                                return;
                        }

-                       if ($d < $main::systime - $pc23_max_age || $d > $main::systime + 900 || $field[2] < 0 || $field[2] > 23) {
+                       if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 900 || $field[2] < 0 || $field[2] > 23) {

                                dbg('chan', "WWV Date ($field[1] $field[2]) out of range");
                                return;
                        }
                        $wwvdup{$dupkey} = $d;
                        $field[6] =~ s/-\d+$//o;            # remove spotter's ssid
                
                                dbg('chan', "WWV Date ($field[1] $field[2]) out of range");
                                return;
                        }
                        $wwvdup{$dupkey} = $d;
                        $field[6] =~ s/-\d+$//o;            # remove spotter's ssid
                

-                       my $wwv = Geomag::update($d, $field[2], $sfi, $k, $i, @field[6..8]);
+                       my $wwv = Geomag::update($d, $field[2], $sfi, $k, $i, @field[6..8], $r);

 
 

-                       my $r;
+                       my $rep;

                        eval {
                        eval {

-                               $r = Local::wwv($self, $field[1], $field[2], $sfi, $k, $i, @field[6..8]);
+                               $rep = Local::wwv($self, $field[1], $field[2], $sfi, $k, $i, @field[6..8], $r);

                        };
 #                      dbg('local', "Local::wwv2 error $@") if $@;
                        };
 #                      dbg('local', "Local::wwv2 error $@") if $@;

-                       return if $r;
+                       return if $rep;

 
                        # DON'T be silly and send on PC27s!
                        return if $pcno == 27;
 
                        # DON'T be silly and send on PC27s!
                        return if $pcno == 27;


@@ -559,7 +566,7 @@ sub normal
                        
                        # spots
                        if ($field[3] > 0) {
                        
                        # spots
                        if ($field[3] > 0) {

-                               my @in = reverse Spot::search(1, undef, undef, 0, $field[3]-1);
+                               my @in = reverse Spot::search(1, undef, undef, 0, $field[3]);

                                my $in;
                                foreach $in (@in) {
                                        $self->send(pc26(@{$in}[0..4], $field[2]));
                                my $in;
                                foreach $in (@in) {
                                        $self->send(pc26(@{$in}[0..4], $field[2]));

diff --git a/perl/Geomag.pm b/perl/Geomag.pm
index 225cb542f087155c84bbe7c2cd9a487dc20bbc10..d78ff2cd3f007fd67cd7b5233ec3db33551ff699 100644 (file)
--- a/perl/Geomag.pm
+++ b/perl/Geomag.pm
@@ -18,13 +18,14 @@ use IO::File;
 use Carp;
 
 use strict;
 use Carp;
 
 use strict;

-use vars qw($date $sfi $k $a $forecast @allowed @denied $fp $node $from);
+use vars qw($date $sfi $k $a $r $forecast @allowed @denied $fp $node $from);

 
 $fp = 0;                                               # the DXLog fcb
 $date = 0;                                             # the unix time of the WWV (notional)
 $sfi = 0;                                              # the current SFI value
 $k = 0;                                                        # the current K value
 $a = 0;                                                        # the current A value
 
 $fp = 0;                                               # the DXLog fcb
 $date = 0;                                             # the unix time of the WWV (notional)
 $sfi = 0;                                              # the current SFI value
 $k = 0;                                                        # the current K value
 $a = 0;                                                        # the current A value

+$r = 0;                                                        # the current R value

 $forecast = "";                                        # the current geomagnetic forecast
 $node = "";                                            # originating node
 $from = "";                                            # who this came from
 $forecast = "";                                        # the current geomagnetic forecast
 $node = "";                                            # originating node
 $from = "";                                            # who this came from


@@ -51,6 +52,7 @@ sub store
        print $fh "\$sfi = $sfi;\n";
        print $fh "\$a = $a;\n";
        print $fh "\$k = $k;\n";
        print $fh "\$sfi = $sfi;\n";
        print $fh "\$a = $a;\n";
        print $fh "\$k = $k;\n";

+       print $fh "\$r = $r;\n";

        print $fh "\$from = '$from';\n";
        print $fh "\$node = '$node';\n";
        print $fh "\@denied = qw(", join(' ', @denied), ");\n" if @denied > 0;
        print $fh "\$from = '$from';\n";
        print $fh "\$node = '$node';\n";
        print $fh "\@denied = qw(", join(' ', @denied), ");\n" if @denied > 0;


@@ -58,13 +60,13 @@ sub store
        close $fh;
        
        # log it
        close $fh;
        
        # log it

-       $fp->writeunix($date, "$from^$date^$sfi^$a^$k^$forecast^$node");
+       $fp->writeunix($date, "$from^$date^$sfi^$a^$k^$forecast^$node^$r");

 }
 
 # update WWV info in one go (usually from a PC23)
 sub update
 {
 }
 
 # update WWV info in one go (usually from a PC23)
 sub update
 {

-       my ($mydate, $mytime, $mysfi, $mya, $myk, $myforecast, $myfrom, $mynode) = @_;
+       my ($mydate, $mytime, $mysfi, $mya, $myk, $myforecast, $myfrom, $mynode, $myr) = @_;

        if ((@allowed && grep {$_ eq $from} @allowed) || 
                (@denied && !grep {$_ eq $from} @denied) ||
                (@allowed == 0 && @denied == 0)) {
        if ((@allowed && grep {$_ eq $from} @allowed) || 
                (@denied && !grep {$_ eq $from} @denied) ||
                (@allowed == 0 && @denied == 0)) {


@@ -72,6 +74,7 @@ sub update
                #       my $trydate = cltounix($mydate, sprintf("%02d18Z", $mytime));
                if ($mydate >= $date) {
                        $sfi = 0 + $mysfi;
                #       my $trydate = cltounix($mydate, sprintf("%02d18Z", $mytime));
                if ($mydate >= $date) {
                        $sfi = 0 + $mysfi;

+            $r = 0 + $myr unless !$r && $myk == $k;

                        $k = 0 + $myk;
                        $a = 0 + $mya;
                        $forecast = $myforecast;
                        $k = 0 + $myk;
                        $a = 0 + $mya;
                        $forecast = $myforecast;


@@ -125,6 +128,11 @@ sub k
        @_ ? $k = shift : $k ;
 }
 
        @_ ? $k = shift : $k ;
 }
 

+sub r
+{
+       @_ ? $r = shift : $r ;
+}
+

 sub a
 {
        @_ ? $a = shift : $a ;
 sub a
 {
        @_ ? $a = shift : $a ;


@@ -135,6 +143,7 @@ sub forecast
        @_ ? $forecast = shift : $forecast ;
 }
 
        @_ ? $forecast = shift : $forecast ;
 }
 

+

 #
 # print some items from the log backwards in time
 #
 #
 # print some items from the log backwards in time
 #