]> scm.dxcluster.org Git - spider.git/commitdiff
1. Do some range checking for spots and WWV in the future (got a WWV for Oct
authordjk <djk>
Thu, 7 Jan 1999 00:57:39 +0000 (00:57 +0000)
committerdjk <djk>
Thu, 7 Jan 1999 00:57:39 +0000 (00:57 +0000)
2034 whhich caused a bit of confusion!)
2. Make WWV spots broadcast them to the users! (as opposed to merely storing
them)(thank you G0RDI).
3. Allow users to do show/announce (thank you JE1SGH).
4. Delay broadcasts to users if they are not in a 'prompt' state (means you can
add messages and see what you are doing on a busy system)
5. Made set/unset dx,ann,wx,talk,wwv do what is expected
6. added set/sys_location and set/set_qra to set the cluster lat/long and qra
7. New messages will now be announced on logon (if there are any)

22 files changed:
Changes
cmd/Aliases
cmd/Commands_en.hlp
cmd/announce.pl
cmd/dx.pl
cmd/set/announce.pl
cmd/set/location.pl
cmd/show/announce.pl
cmd/talk.pl
cmd/unset/announce.pl
cmd/unset/dx.pl
cmd/unset/talk.pl
cmd/unset/wwv.pl
cmd/wwv.pl
cmd/wx.pl
perl/DXChannel.pm
perl/DXCommandmode.pm
perl/DXMsg.pm
perl/DXProt.pm
perl/Geomag.pm
perl/Messages
perl/cluster.pl

diff --git a/Changes b/Changes
index c1f2f0e06689f721c50093045f91651f1924a2f7..bbfa287fe3d8879c4f390e7a3301a68a9b38f02d 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,14 @@
+06Jan99========================================================================
+1. Do some range checking for spots and WWV in the future (got a WWV for Oct 
+2034 whhich caused a bit of confusion!)
+2. Make WWV spots broadcast them to the users! (as opposed to merely storing 
+them)(thank you G0RDI).
+3. Allow users to do show/announce (thank you JE1SGH).
+4. Delay broadcasts to users if they are not in a 'prompt' state (means you can
+add messages and see what you are doing on a busy system)
+5. Made set/unset dx,ann,wx,talk,wwv do what is expected
+6. added set/sys_location and set/set_qra to set the cluster lat/long and qra
+7. New messages will now be announced on logon (if there are any)
 03Jan99========================================================================
 1. Upped the version no !!!!
 2. made the DXProtocol routines much less sensitive to '~' characters (JE1SGH)
 03Jan99========================================================================
 1. Upped the version no !!!!
 2. made the DXProtocol routines much less sensitive to '~' characters (JE1SGH)
index bef5f9d13cbc403419a09d385a8d7e73bbacc037..2d8c21a7000d7670d2c2c4f892233d6e3f4c7f37 100644 (file)
@@ -82,6 +82,11 @@ package CmdAlias;
        's' => [
          '^set/nobe', 'unset/beep', 'unset/beep',
          '^set/nohe', 'unset/here', 'unset/here',
        's' => [
          '^set/nobe', 'unset/beep', 'unset/beep',
          '^set/nohe', 'unset/here', 'unset/here',
+         '^set/noan', 'unset/announce', 'unset/announce',
+         '^set/nodx', 'unset/dx', 'unset/dx',
+         '^set/nota', 'unset/talk', 'unset/talk',
+         '^set/noww', 'unset/wwv', 'unset/wwv',
+         '^set/nowx', 'unset/wx', 'unset/wx',
          '^sh.*/c/n', 'show/configuration nodes', 'show/configuration',
          '^sh.*/c$', 'show/configuration', 'show/configuration',
          '^sh.*/dx/(\d+)-(\d+)', 'show/dx $1-$2', 'show/dx',
          '^sh.*/c/n', 'show/configuration nodes', 'show/configuration',
          '^sh.*/c$', 'show/configuration', 'show/configuration',
          '^sh.*/dx/(\d+)-(\d+)', 'show/dx $1-$2', 'show/dx',
index b553934ff3ca32d4b47ec142d8629b71692aad3a..b78e29db376dd5f651a12395e90b08dc30e0505f 100644 (file)
@@ -247,6 +247,7 @@ You can potentially connect several nodes in this way.
 Remove isolation from a node - SET/ISOLATE
 
 === 0^SET/LOCATION <lat & long>^Set your latitude and longitude
 Remove isolation from a node - SET/ISOLATE
 
 === 0^SET/LOCATION <lat & long>^Set your latitude and longitude
+=== 9^SET/SYS_LOCATION <lat & long>^Set your cluster latitude and longitude
 In order to get accurate headings and such like you must tell the system
 what your latitude and longitude is. If you have not yet done a SET/QRA
 then this command will set your QRA locator for you. For example:-
 In order to get accurate headings and such like you must tell the system
 what your latitude and longitude is. If you have not yet done a SET/QRA
 then this command will set your QRA locator for you. For example:-
@@ -288,6 +289,7 @@ If you are a sysop and you come in as a normal user on a remote connection
 your privilege will automatically be set to 0.
 
 === 0^SET/QRA <locator>^Set your QRA locator
 your privilege will automatically be set to 0.
 
 === 0^SET/QRA <locator>^Set your QRA locator
+=== 9^SET/SYS_QRA <locator>^Set your cluster QRA locator
 Tell the system what your QRA (or Maidenhead) locator is. If you have not
 done a SET/LOCATION then your latitude and longitude will be set roughly
 correctly (assuming your locator is correct ;-). For example:-
 Tell the system what your QRA (or Maidenhead) locator is. If you have not
 done a SET/LOCATION then your latitude and longitude will be set roughly
 correctly (assuming your locator is correct ;-). For example:-
@@ -303,6 +305,9 @@ Tell the system where you are. For example:-
 === 0^SET/WWV^Allow WWV messages to come out on your terminal
 === 0^UNSET/WWV^Stop WWV messages coming out on your terminal
 
 === 0^SET/WWV^Allow WWV messages to come out on your terminal
 === 0^UNSET/WWV^Stop WWV messages coming out on your terminal
 
+=== 0^SET/WX^Allow WX messages to come out on your terminal
+=== 0^UNSET/WX^Stop WX messages coming out on your terminal
+
 === 0^SHOW/DX^Interrogate the spot database
 If you just type SHOW/DX you will get the last so many spots
 (sysop configurable, but usually 10).
 === 0^SHOW/DX^Interrogate the spot database
 If you just type SHOW/DX you will get the last so many spots
 (sysop configurable, but usually 10).
index bb5f7ad0b91135871b3bcafd5c4def0fc300529d..120170399ad6ae17fb1a0f8021b26141e77df62a 100644 (file)
@@ -47,7 +47,7 @@ if ($sort eq "FULL") {
 $line =~ s/\^/:/og;
 
 Log('ann', $to, $from, $line);
 $line =~ s/\^/:/og;
 
 Log('ann', $to, $from, $line);
-DXProt::broadcast_list("To $to de $from <$t>: $line", @locals);
+DXProt::broadcast_list("To $to de $from <$t>: $line", 'ann', undef, @locals);
 if ($to ne "LOCAL") {
   $line =~ s/\^//og;    # remove ^ characters!
   my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 0);
 if ($to ne "LOCAL") {
   $line =~ s/\^//og;    # remove ^ characters!
   my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 0);
index 6645856299290e239c3e885c3d7409aee29fe6ea..41c71c07ffaf9cb43f954651cb9a86dc3cbdc9f9 100644 (file)
--- a/cmd/dx.pl
+++ b/cmd/dx.pl
@@ -84,7 +84,7 @@ $line =~ s/\^/:/og;
 if (Spot::add($freq, $spotted, $main::systime, $line, $spotter)) {
        # send orf to the users
        my $buf = Spot::formatb($freq, $spotted, $main::systime, $line, $spotter);
 if (Spot::add($freq, $spotted, $main::systime, $line, $spotter)) {
        # send orf to the users
        my $buf = Spot::formatb($freq, $spotted, $main::systime, $line, $spotter);
-       DXProt::broadcast_users($buf);
+       DXProt::broadcast_users($buf, 'dx', $buf);
 
 
        # send it orf to the cluster (hang onto your tin helmets)!
 
 
        # send it orf to the cluster (hang onto your tin helmets)!
index 8a77f1eac6e80e350c7836875ef8c90fc2850b39..dd6240476579e16d96b3b9dff18349b4de7c2b77 100644 (file)
@@ -18,9 +18,9 @@ foreach $call (@args) {
   my $chan = DXChannel->get($call);
   if ($chan) {
     $chan->ann(1);
   my $chan = DXChannel->get($call);
   if ($chan) {
     $chan->ann(1);
-       push @out, DXM::msg('anns', $call);
+       push @out, $self->msg('anns', $call);
   } else {
   } else {
-    push @out, DXM::msg('e3', "Set Announce", $call);
+    push @out, $self->msg('e3', "Set Announce", $call);
   }
 }
 return (1, @out);
   }
 }
 return (1, @out);
index a1df5ede26e1d0b556df716756d046c5754d8779..64f6eb890a5d91ecf4b2976fe8d4767a3a370788 100644 (file)
@@ -20,7 +20,6 @@ return (1, $self->msg('loce2', $line)) unless $line =~ /\d+ \d+ [NnSs] \d+ \d+ [
 $user = DXUser->get_current($call);
 if ($user) {
        $line = uc $line;
 $user = DXUser->get_current($call);
 if ($user) {
        $line = uc $line;
-       $user->qra($line);
        my ($lat, $long) = DXBearing::stoll($line);
        $user->lat($lat);
        $user->long($long);
        my ($lat, $long) = DXBearing::stoll($line);
        $user->lat($lat);
        $user->long($long);
index 71b046d0cdf483aa5df7792ed4e3b1426ec220db..bd6e05ae7fcde280390003db3a02e2dd129091e6 100644 (file)
@@ -7,7 +7,8 @@
 #
 my $self = shift;
 
 #
 my $self = shift;
 
-return (1, $self->msg('e5')) if $self->priv < 9;
+# this appears to be a reasonable thing for users to do (thank you JE1SGH)
+# return (1, $self->msg('e5')) if $self->priv < 9;
 
 my $cmdline = shift;
 my @f = split /\s+/, $cmdline;
 
 my $cmdline = shift;
 my @f = split /\s+/, $cmdline;
index e94fd0250e30cf262671082438df449fe666cad4..ebde8888ebd106101c082af5afff612489a218d7 100644 (file)
@@ -42,7 +42,7 @@ $line =~ s/\^/:/og;
 
 my $dxchan = DXCommandmode->get($to); # is it for us?
 if ($dxchan && $dxchan->is_user) {
 
 my $dxchan = DXCommandmode->get($to); # is it for us?
 if ($dxchan && $dxchan->is_user) {
-       $dxchan->send("$to de $from $line");
+       $dxchan->send("$to de $from $line") if $dxchan->talk;
        Log('talk', $to, $from, $main::mycall, $line);
 } else {
        $line =~ s/\^//og;                      # remove any ^ characters
        Log('talk', $to, $from, $main::mycall, $line);
 } else {
        $line =~ s/\^//og;                      # remove any ^ characters
index 9c6e9a9ac52e14a4c0f6fa329d627656d7bb9c01..1ff0b548eb8d10ac0156df261f0857239af235bc 100644 (file)
@@ -1,5 +1,5 @@
 #
 #
-# unset the announce flag
+# set the announce flag
 #
 # Copyright (c) 1998 - Dirk Koopman
 #
 #
 # Copyright (c) 1998 - Dirk Koopman
 #
@@ -15,9 +15,9 @@ my @out;
 
 foreach $call (@args) {
   $call = uc $call;
 
 foreach $call (@args) {
   $call = uc $call;
-  my $user = ($call eq $self->call) ? $self->user :  DXUser->get($call);
-  if ($user) {
-    $user->ann(0);
+  my $chan = DXChannel->get($call);
+  if ($chan) {
+    $chan->ann(0);
        push @out, $self->msg('annu', $call);
   } else {
     push @out, $self->msg('e3', "Unset Announce", $call);
        push @out, $self->msg('annu', $call);
   } else {
     push @out, $self->msg('e3', "Unset Announce", $call);
index b1cf46ec662211f6c953d2f7da65bc76fa466cd1..62e2a33450560cba3fe559376ba586f588cdb374 100644 (file)
@@ -15,9 +15,9 @@ my @out;
 
 foreach $call (@args) {
   $call = uc $call;
 
 foreach $call (@args) {
   $call = uc $call;
-  my $user = ($call eq $self->call) ? $self->user : DXUser->get($call);
-  if ($user) {
-    $user->dx(0);
+  my $chan = DXChannel->get($call);
+  if ($chan) {
+    $chan->dx(0);
        push @out, $self->msg('dxu', $call);
   } else {
     push @out, $self->msg('e3', "Unset DX Spots", $call);
        push @out, $self->msg('dxu', $call);
   } else {
     push @out, $self->msg('e3', "Unset DX Spots", $call);
index 7b119c10ae8593cc573b9b415157c89072afa907..82b71cde0758e7907f8f51a4affe77f1e0c83f23 100644 (file)
@@ -15,9 +15,9 @@ my @out;
 
 foreach $call (@args) {
   $call = uc $call;
 
 foreach $call (@args) {
   $call = uc $call;
-  my $user = ($call eq $self->call) ? $self->user :  DXUser->get($call);
-  if ($user) {
-    $user->talk(0);
+  my $chan = DXChannel->get($call);
+  if ($chan) {
+    $chan->talk(0);
        push @out, $self->msg('talku', $call);
   } else {
     push @out, $self->msg('e3', "Unset Talk", $call);
        push @out, $self->msg('talku', $call);
   } else {
     push @out, $self->msg('e3', "Unset Talk", $call);
index e7c2286a24a17f3f76800a01ed7b0fedac6ecdee..075338a25e7d7bf770255aad0a1d30848b712f3d 100644 (file)
@@ -15,9 +15,9 @@ my @out;
 
 foreach $call (@args) {
   $call = uc $call;
 
 foreach $call (@args) {
   $call = uc $call;
-  my $user = ($call eq $self->call) ? $self->user : DXUser->get($call);
-  if ($user) {
-    $user->wwv(0);
+  my $chan = DXChannel->get($call);
+  if ($chan) {
+    $chan->wwv(0);
        push @out, $self->msg('wwvu', $call);
   } else {
     push @out, $self->msg('e3', "Unset WWV", $call);
        push @out, $self->msg('wwvu', $call);
   } else {
     push @out, $self->msg('e3', "Unset WWV", $call);
index c7b79c3ae132d7a217e9a016467a535ff461bc96..20b8383dcbae90e969bb613b2d89be887af0c301 100644 (file)
@@ -6,4 +6,4 @@
 # $Id$
 #
 my ($self, $line) = @_;
 # $Id$
 #
 my ($self, $line) = @_;
-my @f = 
+return (1, "not implimented yet");
index ecc154013c5aa4fb744f54b8306d8da6d0e56a48..94db5d83ae32f62ccc34c3b768916b5bbb71a81a 100644 (file)
--- a/cmd/wx.pl
+++ b/cmd/wx.pl
@@ -36,7 +36,7 @@ if ($sort eq "FULL") {
   $to = "LOCAL";
 }
 
   $to = "LOCAL";
 }
 
-DXProt::broadcast_list("WX de $from <$t>: $line", @locals);
+DXProt::broadcast_list("WX de $from <$t>: $line", 'wx', undef, @locals);
 if ($to ne "LOCAL") {
   $line =~ s/\^//og;    # remove ^ characters!
   my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 1);
 if ($to ne "LOCAL") {
   $line =~ s/\^//og;    # remove ^ characters!
   my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 1);
index 5505610e9752b8520f6270733fdc0b1387185bc0..e72be8020ae7c3c49740d90df4c48555702b23c5 100644 (file)
@@ -51,6 +51,7 @@ use vars qw(%channels %valid);
                  consort => '9,Connection Type',
                  'sort' => '9,Type of Channel',
                  wwv => '0,Want WWV,yesno',
                  consort => '9,Connection Type',
                  'sort' => '9,Type of Channel',
                  wwv => '0,Want WWV,yesno',
+                 wx => '0,Want WX,yesno',
                  talk => '0,Want Talk,yesno',
                  ann => '0,Want Announce,yesno',
                  here => '0,Here?,yesno',
                  talk => '0,Want Talk,yesno',
                  ann => '0,Want Announce,yesno',
                  here => '0,Here?,yesno',
@@ -68,6 +69,7 @@ use vars qw(%channels %valid);
                  pagedata => '9,Page Data Store',
                  group => '0,Access Group,parray',     # used to create a group of users/nodes for some purpose or other
                  isolate => '9,Isolate network,yesno',
                  pagedata => '9,Page Data Store',
                  group => '0,Access Group,parray',     # used to create a group of users/nodes for some purpose or other
                  isolate => '9,Isolate network,yesno',
+                 delayed => '9,Delayed messages,parray',
                 );
 
 # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
                 );
 
 # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
@@ -203,6 +205,16 @@ sub msg
        return DXM::msg($self->{lang}, @_);
 }
 
        return DXM::msg($self->{lang}, @_);
 }
 
+# stick a broadcast on the delayed queue
+sub delay
+{
+       my $self = shift;
+       my $s = shift;
+       
+       $self->{delayed} = [] unless $self->{delayed};
+       push @{$self->{delayed}}, $s;
+}
+
 # change the state of the channel - lots of scope for debugging here :-)
 sub state
 {
 # change the state of the channel - lots of scope for debugging here :-)
 sub state
 {
@@ -212,6 +224,14 @@ sub state
                $self->{state} = shift;
                $self->{func} = '' unless defined $self->{func};
                dbg('state', "$self->{call} channel func $self->{func} state $self->{oldstate} -> $self->{state}\n");
                $self->{state} = shift;
                $self->{func} = '' unless defined $self->{func};
                dbg('state', "$self->{call} channel func $self->{func} state $self->{oldstate} -> $self->{state}\n");
+
+               # if there is any queued up broadcasts then splurge them out here
+               if ($self->{delayed} && ($self->{state} eq 'prompt' || $self->{state} eq 'convers')) {
+                       for (@{$self->{delayed}}) {
+                               $self->send($_);
+                       }
+                       delete $self->{delayed};
+               }
        }
        return $self->{state};
 }
        }
        return $self->{state};
 }
index b9d8e6cfc7d3b4e9f7eafadb2767cfc420f5df33..2094cbfaea51d6e9abdf4cec110ac1b29093f3f3 100644 (file)
@@ -65,7 +65,7 @@ sub start
        $self->{consort} = $line;       # save the connection type
        
        # set some necessary flags on the user if they are connecting
        $self->{consort} = $line;       # save the connection type
        
        # set some necessary flags on the user if they are connecting
-       $self->{beep} = $self->{wwv} = $self->{talk} = $self->{ann} = $self->{here} = $self->{dx} = 1;
+       $self->{beep} = $self->{wwv} = $self->{wx} = $self->{talk} = $self->{ann} = $self->{here} = $self->{dx} = 1;
        #  $self->prompt() if $self->{state} =~ /^prompt/o;
        
        # add yourself to the database
        #  $self->prompt() if $self->{state} =~ /^prompt/o;
        
        # add yourself to the database
@@ -86,7 +86,7 @@ sub start
        $self->send($self->msg('qthe1')) if !$user->qth;
        $self->send($self->msg('qll')) if !$user->qra || (!$user->lat && !$user->long);
        $self->send($self->msg('hnodee1')) if !$user->qth;
        $self->send($self->msg('qthe1')) if !$user->qth;
        $self->send($self->msg('qll')) if !$user->qra || (!$user->lat && !$user->long);
        $self->send($self->msg('hnodee1')) if !$user->qth;
-
+       $self->send($self->msg('msgnew')) if DXMsg::for_me($call);
        
        $self->send($self->msg('pr', $call));
 }
        
        $self->send($self->msg('pr', $call));
 }
index 0fc327c4c543b6713c92ba456de5ac5cda3b4706..4a81a585616318756a0832a539815c442d3e3bea 100644 (file)
@@ -201,7 +201,7 @@ sub process
                                                $ref->store($ref->{lines});
                                                add_dir($ref);
                                                my $dxchan = DXChannel->get($ref->{to});
                                                $ref->store($ref->{lines});
                                                add_dir($ref);
                                                my $dxchan = DXChannel->get($ref->{to});
-                                               $dxchan->send("New mail has arrived for you") if $dxchan;
+                                               $dxchan->msg('msgnew') if $dxchan;
                                                Log('msg', "Message $ref->{msgno} from $ref->{from} received from $f[2] for $ref->{to}");
                                        }
                                }
                                                Log('msg', "Message $ref->{msgno} from $ref->{from} received from $f[2] for $ref->{to}");
                                        }
                                }
@@ -529,6 +529,21 @@ sub queue_msg
        }
 }
 
        }
 }
 
+# is there a message for me?
+sub for_me
+{
+       my $call = uc shift;
+       my $ref;
+       
+       foreach $ref (@msg) {
+               # is it for me, private and unread? 
+               if ($ref->{to} eq $call && $ref->{private}) {
+                       return 1 if !$ref->{'read'};
+               }
+       }
+       return 0;
+}
+
 # start the message off on its travels with a PC28
 sub start_msg
 {
 # start the message off on its travels with a PC28
 sub start_msg
 {
@@ -727,9 +742,9 @@ sub do_send_stuff
                        delete $loc->{lines};
                        delete $loc->{to};
                        delete $self->{loc};
                        delete $loc->{lines};
                        delete $loc->{to};
                        delete $self->{loc};
-                       $self->state('prompt');
                        $self->func(undef);
                        DXMsg::queue_msg(0);
                        $self->func(undef);
                        DXMsg::queue_msg(0);
+                       $self->state('prompt');
                } elsif ($line eq "\031" || uc $line eq "/ABORT" || uc $line eq "/QUIT") {
                        #push @out, $self->msg('sendabort');
                        push @out, "aborted";
                } elsif ($line eq "\031" || uc $line eq "/ABORT" || uc $line eq "/QUIT") {
                        #push @out, $self->msg('sendabort');
                        push @out, "aborted";
index 01b64372b8d4d1cf55847b76d229fea3b65e984c..b1ce88d6750634806eda9f336382cf221ec473be 100644 (file)
@@ -153,7 +153,7 @@ sub normal
                                Log('talk', $call, $field[1], $field[6], $text);
                                $call = $main::myalias if $call eq $main::mycall;
                                my $ref = DXChannel->get($call);
                                Log('talk', $call, $field[1], $field[6], $text);
                                $call = $main::myalias if $call eq $main::mycall;
                                my $ref = DXChannel->get($call);
-                               $ref->send("$call de $field[1]: $text") if $ref;
+                               $ref->send("$call de $field[1]: $text") if $ref && $ref->{talk};
                        } else {
                                route($field[2], $line); # relay it on its way
                        }
                        } else {
                                route($field[2], $line); # relay it on its way
                        }
@@ -167,9 +167,9 @@ sub normal
                        
                        # convert the date to a unix date
                        my $d = cltounix($field[3], $field[4]);
                        
                        # convert the date to a unix date
                        my $d = cltounix($field[3], $field[4]);
-                       # bang out (and don't pass on) if date is invalid or the spot is too old
-                       if (!$d || ($pcno == 11 && $d < $main::systime - $pc11_max_age)) {
-                               dbg('chan', "Spot ignored, invalid date or too old\n");
+                       # bang out (and don't pass on) if date is invalid or the spot is too old (or too young)
+                       if (!$d || ($pcno == 11 && ($d < $main::systime - $pc11_max_age || $d > $main::systime + 900))) {
+                               dbg('chan', "Spot ignored, invalid date or out of range ($field[3] $field[4])\n");
                                return;
                        }
 
                                return;
                        }
 
@@ -203,7 +203,7 @@ sub normal
                        # send orf to the users
                        if ($spot && $pcno == 11) {
                                my $buf = Spot::formatb($field[1], $field[2], $d, $text, $spotter);
                        # send orf to the users
                        if ($spot && $pcno == 11) {
                                my $buf = Spot::formatb($field[1], $field[2], $d, $text, $spotter);
-                               broadcast_users("$buf\a\a");
+                               broadcast_users("$buf\a\a", 'dx', $spot);
                        }
 
                        # DON'T be silly and send on PC26s!
                        }
 
                        # DON'T be silly and send on PC26s!
@@ -237,9 +237,9 @@ sub normal
                                $target = "All" if !$target;
                                
                                if (@list > 0) {
                                $target = "All" if !$target;
                                
                                if (@list > 0) {
-                                       broadcast_list("$to$target de $field[1]: $text", @list);
+                                       broadcast_list("$to$target de $field[1]: $text", 'ann', undef, @list);
                                } else {
                                } else {
-                                       broadcast_users("$target de $field[1]: $text");
+                                       broadcast_users("$target de $field[1]: $text", 'ann', undef);
                                }
                                Log('ann', $target, $field[1], $text);
                                
                                }
                                Log('ann', $target, $field[1], $text);
                                
@@ -385,9 +385,13 @@ sub normal
                                dbg('chan', "Dup WWV Spot ignored\n");
                                return;
                        }
                                dbg('chan', "Dup WWV Spot ignored\n");
                                return;
                        }
+                       if ($d > $main::systime + 900) {
+                               dbg('chan', "WWV Date ($field[1] $field[2]) out of range");
+                               return;
+                       }
                        
                        $wwvdup{$dupkey} = $d;
                        
                        $wwvdup{$dupkey} = $d;
-                       Geomag::update($field[1], $field[2], $sfi, $k, $i, @field[6..$#field]);
+                       my $wwv = Geomag::update($d, $field[2], $sfi, $k, $i, @field[6..$#field]);
 
                        my $r;
                        eval {
 
                        my $r;
                        eval {
@@ -398,7 +402,9 @@ sub normal
 
                        # DON'T be silly and send on PC27s!
                        return if $pcno == 27;
 
                        # DON'T be silly and send on PC27s!
                        return if $pcno == 27;
-                       
+
+                       # broadcast to the eager users
+                       broadcast_users("WWV de $field[7] <$field[2]>:   SFI=$sfi, K=$k, A=$i, $field[6]", 'wwv', $wwv );
                        last SWITCH;
                }
                
                        last SWITCH;
                }
                
@@ -724,28 +730,45 @@ sub broadcast_ak1a
 }
 
 # broadcast to all users
 }
 
 # broadcast to all users
+# storing the spot or whatever until it is in a state to receive it
 sub broadcast_users
 {
        my $s = shift;                          # the line to be rebroadcast
 sub broadcast_users
 {
        my $s = shift;                          # the line to be rebroadcast
+       my $sort = shift;           # the type of transmission
+       my $fref = shift;           # a reference to an object to filter on
        my @except = @_;                        # to all channels EXCEPT these (dxchannel refs)
        my @dxchan = get_all_users();
        my $dxchan;
        my @except = @_;                        # to all channels EXCEPT these (dxchannel refs)
        my @dxchan = get_all_users();
        my $dxchan;
+       my @out;
        
        foreach $dxchan (@dxchan) {
                next if grep $dxchan == $_, @except;
        
        foreach $dxchan (@dxchan) {
                next if grep $dxchan == $_, @except;
-               $s =~ s/\a//og if !$dxchan->{beep};
-               $dxchan->send($s);              # send it if it isn't the except list or hasn't a passout flag
+               push @out, $dxchan;
        }
        }
+       broadcast_list($s, $sort, $fref, @out);
 }
 
 # broadcast to a list of users
 sub broadcast_list
 {
        my $s = shift;
 }
 
 # broadcast to a list of users
 sub broadcast_list
 {
        my $s = shift;
+       my $sort = shift;
+       my $fref = shift;
        my $dxchan;
        
        foreach $dxchan (@_) {
        my $dxchan;
        
        foreach $dxchan (@_) {
-               $dxchan->send($s);              # send it 
+               
+               next if $sort eq 'dx' && !$dxchan->{dx};
+               next if $sort eq 'ann' && !$dxchan->{ann};
+               next if $sort eq 'wwv' && !$dxchan->{wwv};
+               next if $sort eq 'wx' && !$dxchan->{wx};
+
+               $s =~ s/\a//og unless $dxchan->{beep};
+               if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') {
+                       $dxchan->send($s);      
+               } else {
+                       $dxchan->delay($s);
+               }
        }
 }
 
        }
 }
 
index 8b0d2ea7f4cd0933757ed90f6ac68d174ca9bd3b..d68e724d436214b64825b2052164122e22628397 100644 (file)
@@ -20,23 +20,23 @@ use Carp;
 use strict;
 use vars qw($date $sfi $k $a $forecast @allowed @denied $fp $node $from);
 
 use strict;
 use vars qw($date $sfi $k $a $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
-$forecast = "";     # the current geomagnetic forecast
-$node = "";         # originating node
-$from = "";         # who this came from
-@allowed = ();      # if present only these callsigns are regarded as valid WWV updators
-@denied = ();       # if present ignore any wwv from these callsigns
+$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
+$forecast = "";                                        # the current geomagnetic forecast
+$node = "";                                            # originating node
+$from = "";                                            # who this came from
+@allowed = ();                                 # if present only these callsigns are regarded as valid WWV updators
+@denied = ();                                  # if present ignore any wwv from these callsigns
 my $dirprefix = "$main::data/wwv";
 my $param = "$dirprefix/param";
 
 sub init
 {
        $fp = DXLog::new('wwv', 'dat', 'm');
 my $dirprefix = "$main::data/wwv";
 my $param = "$dirprefix/param";
 
 sub init
 {
        $fp = DXLog::new('wwv', 'dat', 'm');
-       mkdir $dirprefix, 0777 if !-e $dirprefix;        # now unnecessary DXLog will create it
+       mkdir $dirprefix, 0777 if !-e $dirprefix; # now unnecessary DXLog will create it
        do "$param" if -e "$param";
        confess $@ if $@;
 }
        do "$param" if -e "$param";
        confess $@ if $@;
 }
@@ -44,95 +44,95 @@ sub init
 # write the current data away
 sub store
 {
 # write the current data away
 sub store
 {
-  my $fh = new FileHandle;
-  open $fh, "> $param" or confess "can't open $param $!";
-  print $fh "# Geomagnetic data parameter file last mod:", scalar gmtime, "\n";
-  print $fh "\$date = $date;\n";
-  print $fh "\$sfi = $sfi;\n";
-  print $fh "\$a = $a;\n";
-  print $fh "\$k = $k;\n";
-  print $fh "\$from = '$from';\n";
-  print $fh "\$node = '$node';\n";
-  print $fh "\@denied = qw(", join(' ', @denied), ");\n" if @denied > 0;
-  print $fh "\@allowed = qw(", join(' ', @allowed), ");\n" if @allowed > 0;
-  close $fh;
-
-  # log it
-  $fp->writeunix($date, "$from^$date^$sfi^$a^$k^$forecast^$node");
+       my $fh = new FileHandle;
+       open $fh, "> $param" or confess "can't open $param $!";
+       print $fh "# Geomagnetic data parameter file last mod:", scalar gmtime, "\n";
+       print $fh "\$date = $date;\n";
+       print $fh "\$sfi = $sfi;\n";
+       print $fh "\$a = $a;\n";
+       print $fh "\$k = $k;\n";
+       print $fh "\$from = '$from';\n";
+       print $fh "\$node = '$node';\n";
+       print $fh "\@denied = qw(", join(' ', @denied), ");\n" if @denied > 0;
+       print $fh "\@allowed = qw(", join(' ', @allowed), ");\n" if @allowed > 0;
+       close $fh;
+       
+       # log it
+       $fp->writeunix($date, "$from^$date^$sfi^$a^$k^$forecast^$node");
 }
 
 # 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) = @_;
-  if ((@allowed && grep {$_ eq $from} @allowed) || 
-      (@denied && !grep {$_ eq $from} @denied) ||
-         (@allowed == 0 && @denied == 0)) {
-         
-       my $trydate = cltounix($mydate, sprintf("%02d18Z", $mytime));
-       if ($trydate >= $date) {
-      $sfi = 0 + $mysfi;
-      $k = 0 + $myk;
-      $a = 0 + $mya;
-      $forecast = $myforecast;
-         $date = $trydate;
-         $from = $myfrom;
-         $node = $mynode;
-         
-         store();
+       my ($mydate, $mytime, $mysfi, $mya, $myk, $myforecast, $myfrom, $mynode) = @_;
+       if ((@allowed && grep {$_ eq $from} @allowed) || 
+               (@denied && !grep {$_ eq $from} @denied) ||
+               (@allowed == 0 && @denied == 0)) {
+               
+               #       my $trydate = cltounix($mydate, sprintf("%02d18Z", $mytime));
+               if ($mydate >= $date) {
+                       $sfi = 0 + $mysfi;
+                       $k = 0 + $myk;
+                       $a = 0 + $mya;
+                       $forecast = $myforecast;
+                       $date = $mydate;
+                       $from = $myfrom;
+                       $node = $mynode;
+                       
+                       store();
+               }
        }
        }
-  }
 }
 
 # add or substract an allowed callsign
 sub allowed
 {
 }
 
 # add or substract an allowed callsign
 sub allowed
 {
-  my $flag = shift;
-  if ($flag eq '+') {
-    push @allowed, map {uc $_} @_;
-  } else {
-    my $c;
-    foreach $c (@_) {
-         @allowed = map {$_ ne uc $c} @allowed; 
-       } 
-  }
-  store();
+       my $flag = shift;
+       if ($flag eq '+') {
+               push @allowed, map {uc $_} @_;
+       } else {
+               my $c;
+               foreach $c (@_) {
+                       @allowed = map {$_ ne uc $c} @allowed; 
+               
+       }
+       store();
 }
 
 # add or substract a denied callsign
 sub denied
 {
 }
 
 # add or substract a denied callsign
 sub denied
 {
-  my $flag = shift;
-  if ($flag eq '+') {
-    push @denied, map {uc $_} @_;
-  } else {
-    my $c;
-    foreach $c (@_) {
-         @denied = map {$_ ne uc $c} @denied; 
-       } 
-  }
-  store();
+       my $flag = shift;
+       if ($flag eq '+') {
+               push @denied, map {uc $_} @_;
+       } else {
+               my $c;
+               foreach $c (@_) {
+                       @denied = map {$_ ne uc $c} @denied; 
+               
+       }
+       store();
 }
 
 # accessor routines (when I work how symbolic refs work I might use one of those!)
 sub sfi
 {
 }
 
 # accessor routines (when I work how symbolic refs work I might use one of those!)
 sub sfi
 {
-  @_ ? $sfi = shift : $sfi ;
+       @_ ? $sfi = shift : $sfi ;
 }
 
 sub k
 {
 }
 
 sub k
 {
-  @_ ? $k = shift : $k ;
+       @_ ? $k = shift : $k ;
 }
 
 sub a
 {
 }
 
 sub a
 {
-  @_ ? $a = shift : $a ;
+       @_ ? $a = shift : $a ;
 }
 
 sub forecast
 {
 }
 
 sub forecast
 {
-  @_ ? $forecast = shift : $forecast ;
+       @_ ? $forecast = shift : $forecast ;
 }
 
 #
 }
 
 #
@@ -150,24 +150,24 @@ sub search
        my @out;
        my $eval;
        my $count;
        my @out;
        my $eval;
        my $count;
-           
+       
        $search = 1;
        $eval = qq(
                           my \$c;
                           my \$ref;
        $search = 1;
        $eval = qq(
                           my \$c;
                           my \$ref;
-                          for (\$c = \$#in; \$c >= 0; \$c--) {
+                          for (\$c = \$        #in; \$c >= 0; \$c--) {
                                        \$ref = \$in[\$c];
                                        if ($search) {
                                                \$count++;
                                                next if \$count < \$from;
                                                push \@out, \$ref;
                                        \$ref = \$in[\$c];
                                        if ($search) {
                                                \$count++;
                                                next if \$count < \$from;
                                                push \@out, \$ref;
-                                               last if \$count >= \$to;                  # stop after n
+                                               last if \$count >= \$to; # stop after n
                                        }
                                }
                          );
        
                                        }
                                }
                          );
        
-       $fp->close;                                      # close any open files
-
+       $fp->close;                                     # close any open files
+       
        my $fh = $fp->open(@date); 
        for ($count = 0; $count < $to; ) {
                my @in = ();
        my $fh = $fp->open(@date); 
        for ($count = 0; $count < $to; ) {
                my @in = ();
@@ -176,14 +176,14 @@ sub search
                                chomp;
                                push @in, [ split '\^' ] if length > 2;
                        }
                                chomp;
                                push @in, [ split '\^' ] if length > 2;
                        }
-                       eval $eval;               # do the search on this file
+                       eval $eval;                     # do the search on this file
                        return ("Geomag search error", $@) if $@;
                        return ("Geomag search error", $@) if $@;
-                       last if $count >= $to;                  # stop after n
+                       last if $count >= $to; # stop after n
                }
                }
-               $fh = $fp->openprev();      # get the next file
+               $fh = $fp->openprev();  # get the next file
                last if !$fh;
        }
                last if !$fh;
        }
-
+       
        return @out;
 }
 
        return @out;
 }
 
@@ -203,7 +203,7 @@ sub print_item
        my @ref = @$r;
        my $d = cldate($ref[1]);
        my ($t) = (gmtime($ref[1]))[2];
        my @ref = @$r;
        my $d = cldate($ref[1]);
        my ($t) = (gmtime($ref[1]))[2];
-
+       
        return sprintf("$d   %02d %5d %3d %3d %-37s <%s>", $t, $ref[2], $ref[3], $ref[4], $ref[5], $ref[0]);
 }
 
        return sprintf("$d   %02d %5d %3d %3d %-37s <%s>", $t, $ref[2], $ref[3], $ref[4], $ref[5], $ref[0]);
 }
 
index cd4b12ab8b6f84697f2b585f1f28bfecc61e5342..81e3e2c23f98eae719096abe88ffcdcd26843832 100644 (file)
@@ -66,6 +66,7 @@ package DXM;
                                lockoutun => '$_[0] Unlocked',
                                m2 => '$_[0] Information: $_[1]',
                                merge1 => 'Merge request for $_[1] spots and $_[2] WWV sent to $_[0]',
                                lockoutun => '$_[0] Unlocked',
                                m2 => '$_[0] Information: $_[1]',
                                merge1 => 'Merge request for $_[1] spots and $_[2] WWV sent to $_[0]',
+                               msgnew => 'New mail has arrived for you',
                                namee1 => 'Please enter your name, set/name <your name>',
                                namee2 => 'Can\'t find user $_[0]!',
                                name => 'Your name is now \"$_[0]\"',
                                namee1 => 'Please enter your name, set/name <your name>',
                                namee2 => 'Can\'t find user $_[0]!',
                                name => 'Your name is now \"$_[0]\"',
@@ -96,11 +97,15 @@ package DXM;
                                read2 => 'Msg $_[0] not found',
                                read3 => 'Msg $_[0] not available',
                                shutting => '$main::mycall shutting down...',
                                read2 => 'Msg $_[0] not found',
                                read3 => 'Msg $_[0] not available',
                                shutting => '$main::mycall shutting down...',
+                               sloc => 'Cluster lat $_[0] long $_[1], DON\'T FORGET TO CHANGE YOUR DXVars.pm',
+                               sqra => 'Cluster QRA Locator$_[0], DON\'T FORGET TO CHANGE YOUR DXVars.pm',
                                talks => 'Talk flag set on $_[0]',
                                talku => 'Talk flag unset on $_[0]',
                                usernf => '*** User record for $_[0] not found ***',
                                wwvs => 'WWV flag set on $_[0]',
                                wwvu => 'WWV flag unset on $_[0]',
                                talks => 'Talk flag set on $_[0]',
                                talku => 'Talk flag unset on $_[0]',
                                usernf => '*** User record for $_[0] not found ***',
                                wwvs => 'WWV flag set on $_[0]',
                                wwvu => 'WWV flag unset on $_[0]',
+                               wxs => 'WX flag set on $_[0]',
+                               wxu => 'WX flag unset on $_[0]',
                },
   fr => {
                },
                },
   fr => {
                },
index 49bd016cd42a3781f365181f02a876bf93416a56..8dc14ed8a8b0625f613bd359645287c239ad9842 100755 (executable)
@@ -20,9 +20,6 @@ BEGIN {
        
        unshift @INC, "$root/perl";     # this IS the right way round!
        unshift @INC, "$root/local";
        
        unshift @INC, "$root/perl";     # this IS the right way round!
        unshift @INC, "$root/local";
-
-#      require Exporter;
-#      $Exporter::Verbose = 1;
 }
 
 use Msg;
 }
 
 use Msg;
@@ -52,7 +49,7 @@ package main;
 
 @inqueue = ();                                 # the main input queue, an array of hashes
 $systime = 0;                                  # the time now (in seconds)
 
 @inqueue = ();                                 # the main input queue, an array of hashes
 $systime = 0;                                  # the time now (in seconds)
-$version = "1.20";                             # the version no of the software
+$version = "1.21";                             # the version no of the software
 $starttime = 0;                 # the starting time of the cluster   
  
 # handle disconnections
 $starttime = 0;                 # the starting time of the cluster   
  
 # handle disconnections