From 324bd80ed4aef7e2636f5a03288788ce11ab2663 Mon Sep 17 00:00:00 2001 From: djk Date: Thu, 7 Jan 1999 00:57:39 +0000 Subject: [PATCH] 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) --- Changes | 11 +++ cmd/Aliases | 5 ++ cmd/Commands_en.hlp | 5 ++ cmd/announce.pl | 2 +- cmd/dx.pl | 2 +- cmd/set/announce.pl | 4 +- cmd/set/location.pl | 1 - cmd/show/announce.pl | 3 +- cmd/talk.pl | 2 +- cmd/unset/announce.pl | 8 +-- cmd/unset/dx.pl | 6 +- cmd/unset/talk.pl | 6 +- cmd/unset/wwv.pl | 6 +- cmd/wwv.pl | 2 +- cmd/wx.pl | 2 +- perl/DXChannel.pm | 20 ++++++ perl/DXCommandmode.pm | 4 +- perl/DXMsg.pm | 19 +++++- perl/DXProt.pm | 47 +++++++++---- perl/Geomag.pm | 154 +++++++++++++++++++++--------------------- perl/Messages | 5 ++ perl/cluster.pl | 5 +- 22 files changed, 200 insertions(+), 119 deletions(-) diff --git a/Changes b/Changes index c1f2f0e0..bbfa287f 100644 --- 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) diff --git a/cmd/Aliases b/cmd/Aliases index bef5f9d1..2d8c21a7 100644 --- a/cmd/Aliases +++ b/cmd/Aliases @@ -82,6 +82,11 @@ package CmdAlias; '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', diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp index b553934f..b78e29db 100644 --- a/cmd/Commands_en.hlp +++ b/cmd/Commands_en.hlp @@ -247,6 +247,7 @@ You can potentially connect several nodes in this way. Remove isolation from a node - SET/ISOLATE === 0^SET/LOCATION ^Set your latitude and longitude +=== 9^SET/SYS_LOCATION ^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:- @@ -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 ^Set your QRA locator +=== 9^SET/SYS_QRA ^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:- @@ -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/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). diff --git a/cmd/announce.pl b/cmd/announce.pl index bb5f7ad0..12017039 100644 --- a/cmd/announce.pl +++ b/cmd/announce.pl @@ -47,7 +47,7 @@ if ($sort eq "FULL") { $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); diff --git a/cmd/dx.pl b/cmd/dx.pl index 66458562..41c71c07 100644 --- 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); - DXProt::broadcast_users($buf); + DXProt::broadcast_users($buf, 'dx', $buf); # send it orf to the cluster (hang onto your tin helmets)! diff --git a/cmd/set/announce.pl b/cmd/set/announce.pl index 8a77f1ea..dd624047 100644 --- a/cmd/set/announce.pl +++ b/cmd/set/announce.pl @@ -18,9 +18,9 @@ foreach $call (@args) { my $chan = DXChannel->get($call); if ($chan) { $chan->ann(1); - push @out, DXM::msg('anns', $call); + push @out, $self->msg('anns', $call); } else { - push @out, DXM::msg('e3', "Set Announce", $call); + push @out, $self->msg('e3', "Set Announce", $call); } } return (1, @out); diff --git a/cmd/set/location.pl b/cmd/set/location.pl index a1df5ede..64f6eb89 100644 --- a/cmd/set/location.pl +++ b/cmd/set/location.pl @@ -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->qra($line); my ($lat, $long) = DXBearing::stoll($line); $user->lat($lat); $user->long($long); diff --git a/cmd/show/announce.pl b/cmd/show/announce.pl index 71b046d0..bd6e05ae 100644 --- a/cmd/show/announce.pl +++ b/cmd/show/announce.pl @@ -7,7 +7,8 @@ # 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; diff --git a/cmd/talk.pl b/cmd/talk.pl index e94fd025..ebde8888 100644 --- a/cmd/talk.pl +++ b/cmd/talk.pl @@ -42,7 +42,7 @@ $line =~ s/\^/:/og; 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 diff --git a/cmd/unset/announce.pl b/cmd/unset/announce.pl index 9c6e9a9a..1ff0b548 100644 --- a/cmd/unset/announce.pl +++ b/cmd/unset/announce.pl @@ -1,5 +1,5 @@ # -# unset the announce flag +# set the announce flag # # Copyright (c) 1998 - Dirk Koopman # @@ -15,9 +15,9 @@ my @out; 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); diff --git a/cmd/unset/dx.pl b/cmd/unset/dx.pl index b1cf46ec..62e2a334 100644 --- a/cmd/unset/dx.pl +++ b/cmd/unset/dx.pl @@ -15,9 +15,9 @@ my @out; 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); diff --git a/cmd/unset/talk.pl b/cmd/unset/talk.pl index 7b119c10..82b71cde 100644 --- a/cmd/unset/talk.pl +++ b/cmd/unset/talk.pl @@ -15,9 +15,9 @@ my @out; 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); diff --git a/cmd/unset/wwv.pl b/cmd/unset/wwv.pl index e7c2286a..075338a2 100644 --- a/cmd/unset/wwv.pl +++ b/cmd/unset/wwv.pl @@ -15,9 +15,9 @@ my @out; 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); diff --git a/cmd/wwv.pl b/cmd/wwv.pl index c7b79c3a..20b8383d 100644 --- a/cmd/wwv.pl +++ b/cmd/wwv.pl @@ -6,4 +6,4 @@ # $Id$ # my ($self, $line) = @_; -my @f = +return (1, "not implimented yet"); diff --git a/cmd/wx.pl b/cmd/wx.pl index ecc15401..94db5d83 100644 --- a/cmd/wx.pl +++ b/cmd/wx.pl @@ -36,7 +36,7 @@ if ($sort eq "FULL") { $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); diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 5505610e..e72be802 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -51,6 +51,7 @@ use vars qw(%channels %valid); 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', @@ -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', + delayed => '9,Delayed messages,parray', ); # 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}, @_); } +# 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 { @@ -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"); + + # 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}; } diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index b9d8e6cf..2094cbfa 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -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->{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 @@ -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('msgnew')) if DXMsg::for_me($call); $self->send($self->msg('pr', $call)); } diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 0fc327c4..4a81a585 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -201,7 +201,7 @@ sub process $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}"); } } @@ -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 { @@ -727,9 +742,9 @@ sub do_send_stuff delete $loc->{lines}; delete $loc->{to}; delete $self->{loc}; - $self->state('prompt'); $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"; diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 01b64372..b1ce88d6 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -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); - $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 } @@ -167,9 +167,9 @@ sub normal # 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; } @@ -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); - broadcast_users("$buf\a\a"); + broadcast_users("$buf\a\a", 'dx', $spot); } # DON'T be silly and send on PC26s! @@ -237,9 +237,9 @@ sub normal $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 { - broadcast_users("$target de $field[1]: $text"); + broadcast_users("$target de $field[1]: $text", 'ann', undef); } Log('ann', $target, $field[1], $text); @@ -385,9 +385,13 @@ sub normal 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; - 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 { @@ -398,7 +402,9 @@ sub normal # 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; } @@ -724,28 +730,45 @@ sub broadcast_ak1a } # 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 + 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 @out; 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; + my $sort = shift; + my $fref = shift; 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); + } } } diff --git a/perl/Geomag.pm b/perl/Geomag.pm index 8b0d2ea7..d68e724d 100644 --- a/perl/Geomag.pm +++ b/perl/Geomag.pm @@ -20,23 +20,23 @@ use Carp; 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'); - 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 $@; } @@ -44,95 +44,95 @@ sub init # 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 { - 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 { - 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 { - 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 { - @_ ? $sfi = shift : $sfi ; + @_ ? $sfi = shift : $sfi ; } sub k { - @_ ? $k = shift : $k ; + @_ ? $k = shift : $k ; } sub a { - @_ ? $a = shift : $a ; + @_ ? $a = shift : $a ; } sub forecast { - @_ ? $forecast = shift : $forecast ; + @_ ? $forecast = shift : $forecast ; } # @@ -150,24 +150,24 @@ sub search my @out; my $eval; my $count; - + $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; - 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 = (); @@ -176,14 +176,14 @@ sub search 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 $@; - 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; } - + return @out; } @@ -203,7 +203,7 @@ sub print_item 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]); } diff --git a/perl/Messages b/perl/Messages index cd4b12ab..81e3e2c2 100644 --- a/perl/Messages +++ b/perl/Messages @@ -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]', + msgnew => 'New mail has arrived for you', namee1 => 'Please enter your name, set/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...', + 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]', + wxs => 'WX flag set on $_[0]', + wxu => 'WX flag unset on $_[0]', }, fr => { }, diff --git a/perl/cluster.pl b/perl/cluster.pl index 49bd016c..8dc14ed8 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -20,9 +20,6 @@ BEGIN { unshift @INC, "$root/perl"; # this IS the right way round! unshift @INC, "$root/local"; - -# require Exporter; -# $Exporter::Verbose = 1; } use Msg; @@ -52,7 +49,7 @@ package main; @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 -- 2.43.0