use DXUtil;
use USDB;
use LRU;
+use DXBearing;
use strict;
%prefix_loc = (); # the meat of the info
%pre = (); # the prefix list
$hits = $misses = $matchtotal = 1; # cache stats
-$lrusize = 1000; # size of prefix LRU cache
+$lrusize = 5000; # size of prefix LRU cache
sub init
{
# 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);
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:-
#
sub lru_put
{
my ($call, $ref) = @_;
+ $call =~ s/^=//;
my @s = USDB::get($call);
if (@s) {
}
# we are a pirate!
- @nout = matchprefix('Q');
+ @nout = matchprefix('QQ');
$misses++;
lru_put($call, \@nout);
push @out, @nout;
}
my %valid = (
+ city => '0,City',
+ cont => '0,Continent',
+ cq => '0,CQ',
+ dxcc => '0,DXCC',
+ itu => '0,ITU',
lat => '0,Latitude,slat',
long => '0,Longitude,slong',
- dxcc => '0,DXCC',
name => '0,Name',
- itu => '0,ITU',
- cq => '0,CQ',
+ qra => '0,Locator',
state => '0,State',
- city => '0,City',
utcoff => '0,UTC offset',
- cont => '0,Continent',
);
sub AUTOLOAD