fix prefix error

diff --git a/Changes b/Changes
index c111566912a7132db0e482a0562017ea63664790..6c97a796c66b691dcddb4c5d40706f2de336a1df 100644 (file)
--- 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 8177e1e563de4d229e7d5c7ab2d823e23a457b1e..200a4f1ee5331f98d547b49c3acab674a99b19cc 100644 (file)
--- 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 15b6752dbcbc2bfef0810e4d408a730273253be1..32b1e72ec0ec65c57ae4ba4218c3b163b394a8b1 100644 (file)
--- 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;
 }