+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.
$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 {
$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 {
$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 {
$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 {
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;
}
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:-',
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',
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]',
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, /<cmd> to run a command',
talknh => 'Sorry $_[0] is not online at the moment',
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]',
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 = (
@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
projects / spider.git / commitdiff