From da7476ca7af0722de0cab439f6f4eea3d767daf4 Mon Sep 17 00:00:00 2001 From: minima Date: Tue, 25 Jun 2002 13:11:24 +0000 Subject: [PATCH] fix prefix error --- Changes | 2 ++ cmd/show/prefix.pl | 20 +++++++++----------- perl/Prefix.pm | 11 +++++++++-- 3 files changed, 20 insertions(+), 13 deletions(-) diff --git a/Changes b/Changes index c1115669..6c97a796 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,5 @@ +25Jun02======================================================================= +1. as predicted there was an error in the Prefix routine, I have improved it. 24Jun02======================================================================= 1. make set/badspotter non SSID sensitive. Set/badnode is left to be SSID sensitive. diff --git a/cmd/show/prefix.pl b/cmd/show/prefix.pl index 8177e1e5..200a4f1e 100644 --- a/cmd/show/prefix.pl +++ b/cmd/show/prefix.pl @@ -5,23 +5,21 @@ # my ($self, $line) = @_; -my @list = split /\s+/, $line; # generate a list of callsigns +my @list = split /\s+/, $line; # generate a list of callsigns my $l; my @out; #print "line: $line\n"; foreach $l (@list) { - my @ans = Prefix::extract($l); -# my $dd = new Data::Dumper([ \@ans ]); -# print "ans:", $dd->Dumpxs; - next if !@ans; - my $pre = shift @ans; - my $a; - foreach $a (@ans) { - push @out, sprintf "%s DXCC: %d ITU: %d CQ: %d LL: %s %s (%s, %s)", uc $l, $a->dxcc, $a->itu, $a->cq, slat($a->lat), slong($a->long), $pre, $a->name; - $l = " " x length $l; - } + my @ans = Prefix::extract($l); + next if !@ans; + my $pre = shift @ans; + my $a; + foreach $a (@ans) { + push @out, sprintf "%s DXCC: %d ITU: %d CQ: %d LL: %s %s (%s, %s)", uc $l, $a->dxcc, $a->itu, $a->cq, slat($a->lat), slong($a->long), $pre, $a->name; + $l = " " x length $l; + } } return (1, @out); diff --git a/perl/Prefix.pm b/perl/Prefix.pm index 15b6752d..32b1e72e 100644 --- a/perl/Prefix.pm +++ b/perl/Prefix.pm @@ -173,21 +173,28 @@ sub extract } # which is the shortest part (first if equal)? + dbg("Parts: $call = " . join('|', @parts)) if isdbg('prefix'); $sp = $parts[0]; foreach $p (@parts) { - $sp = $p if length $sp > length $p; + $sp = $p if length $p < length $sp; } + $sp =~ s/-\d+$//; # remove any SSID + # # now start to resolve it from the left hand end # 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)); - last if @wout > 0 && $wout[0] gt $sp; + next if @wout > 0 && $wout[0] gt $sp; # last if @wout == 0; push @out, @wout; last if @wout; } } + if (isdbg('prefix')) { + my $dd = new Data::Dumper([ \@out ], [qw(@out)]); + dbg($dd->Dumpxs); + } return @out; } -- 2.43.0