From f7ad460466e7e783eda20d467146ef29fde1f4fa Mon Sep 17 00:00:00 2001 From: minima Date: Wed, 12 Jun 2002 20:50:56 +0000 Subject: [PATCH] fix messages in DXDb.pm to point to the correct ones. Thanks Rene (oz1lqh) add missing wcys and wcyu messages to Messages. Thanks Rene (again) upissue version number to 1.50 (finally) fixed (un)set/wwv and (un)set/wcy so they don't issue spurious messages. Thanks Rene (oz1lqh) --- Changes | 7 +++++ cmd/set/wcy.pl | 2 +- cmd/set/wwv.pl | 2 +- cmd/unset/wcy.pl | 2 +- cmd/unset/wwv.pl | 2 +- perl/DXDb.pm | 6 ++-- perl/Messages | 30 ++++++++++--------- perl/Prefix.pm | 75 ++++++++++++++++++++++++------------------------ perl/cluster.pl | 2 +- 9 files changed, 69 insertions(+), 59 deletions(-) diff --git a/Changes b/Changes index 62d891a9..ab3605e2 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,10 @@ +12Jun02======================================================================= +1. fixed (un)set/wwv and (un)set/wcy so they don't issue spurious messages. +Thanks Rene (oz1lqh) +07Jun02======================================================================= +1. fix messages in DXDb.pm to point to the correct ones. Thanks Rene (oz1lqh) +2. add missing wcys and wcyu messages to Messages. Thanks Rene (again) +2. upissue version number to 1.50 (finally) 16Apr02======================================================================= 1. allow the rest of PC19 to continue if it contains a reference to a locally connected node. Thank you Tommy SM3OSM. diff --git a/cmd/set/wcy.pl b/cmd/set/wcy.pl index 47461127..1aed404c 100644 --- a/cmd/set/wcy.pl +++ b/cmd/set/wcy.pl @@ -17,7 +17,7 @@ foreach $call (@args) { $call = uc $call; my $chan = DXChannel->get($call); if ($chan) { - $chan->wcy(1); + DXChannel::wcy($chan, 1); $chan->user->wantwcy(1); push @out, $self->msg('wcys', $call); } else { diff --git a/cmd/set/wwv.pl b/cmd/set/wwv.pl index d713e483..1c1ff9cc 100644 --- a/cmd/set/wwv.pl +++ b/cmd/set/wwv.pl @@ -17,7 +17,7 @@ foreach $call (@args) { $call = uc $call; my $chan = DXChannel->get($call); if ($chan) { - $chan->wwv(1); + DXChannel::wwv($chan, 1); $chan->user->wantwwv(1); push @out, $self->msg('wwvs', $call); } else { diff --git a/cmd/unset/wcy.pl b/cmd/unset/wcy.pl index 965a3d37..42b098a3 100644 --- a/cmd/unset/wcy.pl +++ b/cmd/unset/wcy.pl @@ -17,7 +17,7 @@ foreach $call (@args) { $call = uc $call; my $chan = DXChannel->get($call); if ($chan) { - $chan->wcy(0); + DXChannel::wcy($chan, 0); $chan->user->wantwcy(0); push @out, $self->msg('wcyu', $call); } else { diff --git a/cmd/unset/wwv.pl b/cmd/unset/wwv.pl index 51882a46..eebf16d7 100644 --- a/cmd/unset/wwv.pl +++ b/cmd/unset/wwv.pl @@ -17,7 +17,7 @@ foreach $call (@args) { $call = uc $call; my $chan = DXChannel->get($call); if ($chan) { - $chan->wwv(0); + DXChannel::wwv($chan, 0); $chan->user->wantwwv(0); push @out, $self->msg('wwvu', $call); } else { diff --git a/perl/DXDb.pm b/perl/DXDb.pm index 6ee8f939..db26d4aa 100644 --- a/perl/DXDb.pm +++ b/perl/DXDb.pm @@ -262,18 +262,18 @@ sub process my $db = getdesc($f[4]); if ($db) { if ($db->{remote}) { - sendremote($dxchan, $f[2], $f[3], $dxchan->msg('dx1', $db->{remote})); + sendremote($dxchan, $f[2], $f[3], $dxchan->msg('db1', $db->{remote})); } else { my $value = $db->getkey($f[5]); if ($value) { my @out = split /\n/, $value; sendremote($dxchan, $f[2], $f[3], @out); } else { - sendremote($dxchan, $f[2], $f[3], $dxchan->msg('dx2', $f[5], $db->{name})); + sendremote($dxchan, $f[2], $f[3], $dxchan->msg('db2', $f[5], $db->{name})); } } } else { - sendremote($dxchan, $f[2], $f[3], $dxchan->msg('dx3', $f[4])); + sendremote($dxchan, $f[2], $f[3], $dxchan->msg('db3', $f[4])); } last SWITCH; } diff --git a/perl/Messages b/perl/Messages index 6a2b4fb5..60ad432c 100644 --- a/perl/Messages +++ b/perl/Messages @@ -12,10 +12,10 @@ package DXM; en => { addr => 'Address set to: $_[0]', already => '$_[0] already connnected', - anns => 'Announce flag set on $_[0]', - annu => 'Announce flag unset on $_[0]', - annts => 'AnnTalk flag set on $_[0]', - anntu => 'AnnTalk flag unset on $_[0]', + anns => 'Announces enabled for $_[0]', + annu => 'Announces disabled for $_[0]', + annts => 'AnnTalk enabled for $_[0]', + anntu => 'AnnTalk disabled for $_[0]', badnode1 => '$_[0] is now a bad node', badnode2 => '$_[0] is now a good node', badnode3 => 'List of Bad Nodes:-', @@ -52,8 +52,8 @@ package DXM; dx1 => 'Frequency $_[0] not in band (see show/band); usage: DX [BY call] freq call comments', dx2 => 'Need a callsign; usage: DX [BY call] freq call comments', dx3 => 'The callsign or frequency is invalid', - dxs => 'DX Spots flag set on $_[0]', - dxu => 'DX Spots flag unset on $_[0]', + dxs => 'DX Spots enabled for $_[0]', + dxu => 'DX Spots disabled for $_[0]', e1 => 'Invalid command', e2 => 'Error: $_[0]', e3 => '$_[0]: $_[1] not found', @@ -100,8 +100,8 @@ package DXM; filter4 => '$_[0]$_[1] Filter $_[2] deleted for $_[3]', filter5 => 'need some filter commands...', filter6 => '$_[0]$_[1] Filter for $[2] not found', - grids => 'DX Grid flag set on $_[0]', - gridu => 'DX Grid flag unset on $_[0]', + grids => 'DX Grid enabled for $_[0]', + gridu => 'DX Grid disabled for $_[0]', illcall => 'Sorry, $_[0] is an invalid callsign', hasha => '$_[0] already exists in $_[1]', hashb => '$_[0] added to $_[1]', @@ -261,8 +261,8 @@ package DXM; time1 => 'Local Time: $_[0] $_[1], UTC $_[2]', time2 => '$_[0] Local (standard) time: $_[1] ($_[2] Hours)', time3 => '$_[0] $_[1]', - talks => 'Talk flag set on $_[0]', - talku => 'Talk flag unset on $_[0]', + talks => 'Talk enabled for $_[0]', + talku => 'Talk disabled for $_[0]', talkend => 'Finished talking to you', talkinst => 'Entering Talkmode, /EX to end, / to run a command', talknh => 'Sorry $_[0] is not online at the moment', @@ -273,12 +273,14 @@ package DXM; usernf => '*** User record for $_[0] not found ***', wcy1 => '$_[0] is missing or out of range', wcy2 => 'Duplicate WCY', + wcys => 'WCY enabled for $_[0]', + wcyu => 'WCY disabled for $_[0]', wwv1 => '$_[0] is missing or out of range', wwv2 => 'Duplicate WWV', - wwvs => 'WWV flag set on $_[0]', - wwvu => 'WWV flag unset on $_[0]', - wxs => 'WX flag set on $_[0]', - wxu => 'WX flag unset on $_[0]', + wwvs => 'WWV enabled for $_[0]', + wwvu => 'WWV disabled $_[0]', + wxs => 'WX enabled for $_[0]', + wxu => 'WX disabled for $_[0]', }, nl => { addr => 'Addres gezet op: $_[0]', diff --git a/perl/Prefix.pm b/perl/Prefix.pm index 954490fc..01e3079c 100644 --- a/perl/Prefix.pm +++ b/perl/Prefix.pm @@ -140,51 +140,52 @@ sub next sub extract { - my $call = uc shift; + my $calls = uc shift; my @out; - my @nout; my $p; my @parts; - my ($sp, $i); + my ($call, $sp, $i); - # first check if the whole thing succeeds - @out = get($call); - return @out if @out > 0 && $out[0] eq $call; - - # now split the call into parts if required - @parts = ($call =~ '/') ? split('/', $call) : ($call); - - # remove any /0-9 /P /A /M /MM /AM suffixes etc - if (@parts > 1) { - $p = $parts[0]; - shift @parts if $p =~ /^(WEB|NET)$/o; - $p = $parts[$#parts]; - pop @parts if $p =~ /^(\d+|[JPABM]|AM|MM|BCN|JOTA|SIX|WEB|NET|Q\w+)$/o; - $p = $parts[$#parts]; - pop @parts if $p =~ /^(\d+|[JPABM]|AM|MM|BCN|JOTA|SIX|WEB|NET|Q\w+)$/o; + foreach $call (split /,/, $calls) { + # first check if the whole thing succeeds + my @nout = get($call); + push @out, @nout if @nout; + next if @nout > 0 && $nout[0] eq $call; + + # now split the call into parts if required + @parts = ($call =~ '/') ? split('/', $call) : ($call); + + # remove any /0-9 /P /A /M /MM /AM suffixes etc + if (@parts > 1) { + $p = $parts[0]; + shift @parts if $p =~ /^(WEB|NET)$/o; + $p = $parts[$#parts]; + pop @parts if $p =~ /^(\d+|[JPABM]|AM|MM|BCN|JOTA|SIX|WEB|NET|Q\w+)$/o; + $p = $parts[$#parts]; + pop @parts if $p =~ /^(\d+|[JPABM]|AM|MM|BCN|JOTA|SIX|WEB|NET|Q\w+)$/o; + + # can we resolve them by direct lookup + foreach $p (@parts) { + @nout = get($p); + push @out, @nout if @nout; + next if @nout > 0 && $nout[0] eq $call; + } + } - # can we resolve them by direct lookup + # which is the shortest part (first if equal)? + $sp = $parts[0]; foreach $p (@parts) { - @out = get($p); - return @out if @out > 0 && $out[0] eq $call; + $sp = $p if length $sp > length $p; + } + # now start to resolve it from the left hand end + for ($i = 1; $i <= length $sp; ++$i) { + my @wout = get(substr($sp, 0, $i)); + last if @wout > 0 && $wout[0] gt $sp; + last if @wout == 0; + push @out, @wout; } } - - # which is the shortest part (first if equal)? - $sp = $parts[0]; - foreach $p (@parts) { - $sp = $p if length $sp > length $p; - } - # now start to resolve it from the left hand end - for (@out = (), $i = 1; $i <= length $sp; ++$i) { - @nout = get(substr($sp, 0, $i)); - last if @nout > 0 && $nout[0] gt $sp; - last if @nout == 0; - @out = @nout; - } - - # not found - return (@out > 0) ? @out : (); + return @out; } my %valid = ( diff --git a/perl/cluster.pl b/perl/cluster.pl index aef9a4be..b33a8b6e 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -113,7 +113,7 @@ use vars qw(@inqueue $systime $version $starttime $lockfn @outstanding_connects @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) -$version = "1.49"; # the version no of the software +$version = "1.50"; # the version no of the software $starttime = 0; # the starting time of the cluster #@outstanding_connects = (); # list of outstanding connects @listeners = (); # list of listeners -- 2.34.1