From 6ca8d8f4ec9adb560d0df1e386b98f74c9ba9cb0 Mon Sep 17 00:00:00 2001 From: minima Date: Thu, 4 Jul 2002 14:59:27 +0000 Subject: [PATCH] fix the japanese problem resolving JA callsigns --- Changes | 3 +++ perl/Prefix.pm | 22 +++++++++++++++------- 2 files changed, 18 insertions(+), 7 deletions(-) diff --git a/Changes b/Changes index 52e98d82..10203196 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,6 @@ +04Jul02======================================================================= +1. added another fix to Prefix.pm so that it resolves Japan callsigns again +also you can 'set/debug prefix' to see what it is trying to do. 03Jul02======================================================================= 1. Added the DEMONSTRATE command which allows a sysop to demonstrate a command to a user (from a request by Charlie K1XX). diff --git a/perl/Prefix.pm b/perl/Prefix.pm index 32b1e72e..ed1bd25f 100644 --- a/perl/Prefix.pm +++ b/perl/Prefix.pm @@ -149,9 +149,12 @@ sub extract 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; - + if (@nout && $nout[0] eq $call) { + dbg("got exact prefix: $nout[0]") if isdbg('prefix'); + push @out, @nout; + next; + } + # now split the call into parts if required @parts = ($call =~ '/') ? split('/', $call) : ($call); @@ -167,8 +170,11 @@ sub extract # 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; + if (@nout && $nout[0] eq $call) { + dbg("got exact prefix: $nout[0]") if isdbg('prefix'); + push @out, @nout; + next; + } } } @@ -184,8 +190,10 @@ sub extract # for ($i = 1; $i <= length $sp; ++$i) { # now start to resolve it from the right hand end for ($i = length $sp; $i >= 1; --$i) { - my @wout = get(substr($sp, 0, $i)); - next if @wout > 0 && $wout[0] gt $sp; + my $ssp = substr($sp, 0, $i); + my @wout = get($ssp); + dbg("Partial prefix: $sp $ssp $wout[0]" ) if isdbg('prefix') && $wout[0]; + next if @wout > 0 && $wout[0] gt $ssp; # last if @wout == 0; push @out, @wout; last if @wout; -- 2.43.0