latest version of RBN. Add qra to prefixes.

[spider.git] / perl / Prefix.pm

diff --git a/perl/Prefix.pm b/perl/Prefix.pm
index 028f2cb04fa6c2f679f794ef5012462e83dea6fa..37afddf7c075e7d00efefb143e0585d4b58bdc2f 100644 (file)
--- a/perl/Prefix.pm
+++ b/perl/Prefix.pm
@@ -16,6 +16,7 @@ use DXDebug;
 use DXUtil;
 use USDB;
 use LRU;
+use DXBearing;
 
 use strict;
 
@@ -72,7 +73,10 @@ sub load
        # tie the main prefix database
        eval {$db = tie(%pre, "DB_File", undef, O_RDWR|O_CREAT, 0664, $DB_BTREE);};
        my $out = "$@($!)" if !$db || $@ ;
-       eval {do "$main::data/prefix_data.pl" if !$out; };
+       my $fn = localdata("prefix_data.pl");
+       die "Prefix.pm: cannot find $fn, have you run /spider/perl/create_prefix.pl?" unless -e $fn;
+       
+       eval {do $fn if !$out; };
        $out .= $@ if $@;
        $lru = LRU->newbase('Prefix', $lrusize);
 
@@ -84,49 +88,6 @@ sub loaded
        return $db;
 }
 
-sub store
-{
-       my ($k, $l);
-       my $fh = new IO::File;
-       my $fn = "$main::data/prefix_data.pl";
-  
-       confess "Prefix system not started" if !$db;
-  
-       # save versions!
-       rename "$fn.oooo", "$fn.ooooo" if -e "$fn.oooo";
-       rename "$fn.ooo", "$fn.oooo" if -e "$fn.ooo";
-       rename "$fn.oo", "$fn.ooo" if -e "$fn.oo";
-       rename "$fn.o", "$fn.oo" if -e "$fn.o";
-       rename "$fn", "$fn.o" if -e "$fn";
-  
-       $fh->open(">$fn") or die "Can't open $fn ($!)";
-
-       # prefix location data
-       $fh->print("%prefix_loc = (\n");
-       foreach $l (sort {$a <=> $b} keys %prefix_loc) {
-               my $r = $prefix_loc{$l};
-               $fh->printf("   $l => bless( { name => '%s', dxcc => %d, itu => %d, utcoff => %d, lat => %f, long => %f }, 'Prefix'),\n",
-                                       $r->{name}, $r->{dxcc}, $r->{itu}, $r->{cq}, $r->{utcoff}, $r->{lat}, $r->{long});
-       }
-       $fh->print(");\n\n");
-
-       # prefix data
-       $fh->print("%pre = (\n");
-       foreach $k (sort keys %pre) {
-               $fh->print("   '$k' => [");
-               my @list = @{$pre{$k}};
-               my $l;
-               my $str;
-               foreach $l (@list) {
-                       $str .= " $l,";
-               }
-               chop $str;  
-               $fh->print("$str ],\n");
-       }
-       $fh->print(");\n");
-       undef $fh;
-       untie %pre; 
-}
 
 # what you get is a list that looks like:-
 # 
@@ -170,6 +131,7 @@ sub next
 sub lru_put
 {
        my ($call, $ref) = @_;
+       $call =~ s/^=//;
        my @s = USDB::get($call);
        
        if (@s) {
@@ -441,7 +403,7 @@ L1:         for ($n = 0; $n < @parts; $n++) {
                }
 
                # we are a pirate!
-               @nout = matchprefix('Q');
+               @nout = matchprefix('QQ');
                $misses++;
                lru_put($call, \@nout);
                push @out, @nout;
@@ -520,6 +482,7 @@ my %valid = (
                         city => '0,City',
                         utcoff => '0,UTC offset',
                         cont => '0,Continent',
+                        qra => '0,Locator',
                        );
 
 sub AUTOLOAD