X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FPrefix.pm;h=91f7c5cee44a3753cf90256ca565f007c16d033e;hb=d384410d4d5d1031cabab44350b80f2a55fe808d;hp=5733ff0254c689dabde03a16371b1f412b442d48;hpb=8178d787d7cc8040fa8958197582bba5c80e6f59;p=spider.git

diff --git a/perl/Prefix.pm b/perl/Prefix.pm
index 5733ff02..91f7c5ce 100644
--- a/perl/Prefix.pm
+++ b/perl/Prefix.pm
@@ -31,9 +31,37 @@ $db = undef;					# the DB_File handle
 %prefix_loc = ();				# the meat of the info
 %pre = ();						# the prefix list
 $hits = $misses = $matchtotal = 1;		# cache stats
-$lrusize = 2000;				# size of prefix LRU cache
+$lrusize = 1000;				# size of prefix LRU cache
 
-$lru = LRU->newbase('Prefix', $lrusize);
+sub init
+{
+	my $r = load();
+	return $r if $r;
+
+	# fix up the node's default country codes
+	unless (@main::my_cc) {
+		push @main::my_cc, (61..67) if $main::mycall =~ /^GB/;
+		push @main::my_cc, qw(EA EA6 EA8 EA9) if $main::mycall =~ /^E[ABCD]/;
+		push @main::my_cc, qw(I IT IS) if $main::mycall =~ /^I/;
+		push @main::my_cc, qw(SV SV5 SV9) if $main::mycall =~ /^SV/;
+
+		# catchall
+		push @main::my_cc, $main::mycall unless @main::my_cc;
+	}
+
+	my @c;
+	for (@main::my_cc) {
+		if (/^\d+$/) {
+			push @c, $_;
+		} else {
+			my @dxcc = extract($_);
+			push @c, $dxcc[1]->dxcc if @dxcc > 1;
+		}
+	}
+	return "\@main::my_cc does not contain a valid prefix or callsign (" . join(',', @main::my_cc) . ")" unless @c;
+	@main::my_cc = @c;
+	return undef;
+}
 
 sub load
 {
@@ -43,6 +71,8 @@ sub load
 		untie %pre;
 		%pre = ();
 		%prefix_loc = ();
+		$lru->close if $lru;
+		undef $lru;
 	}
 
 	# tie the main prefix database
@@ -50,10 +80,16 @@ sub load
 	my $out = $@ if $@;
 	do "$main::data/prefix_data.pl" if !$out;
 	$out = $@ if $@;
+	$lru = LRU->newbase('Prefix', $lrusize);
 
  	return $out;
 }
 
+sub loaded
+{
+	return $db;
+}
+
 sub store
 {
 	my ($k, $l);
@@ -452,7 +488,6 @@ my %valid = (
 
 sub AUTOLOAD
 {
-	my $self = shift;
 	no strict;
 	my $name = $AUTOLOAD;
   
@@ -463,7 +498,7 @@ sub AUTOLOAD
 	# this clever line of code creates a subroutine which takes over from autoload
 	# from OO Perl - Conway
 	*$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
-	&$AUTOLOAD($self, @_);
+       goto &$AUTOLOAD;
 }
 
 #