X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FPrefix.pm;h=da173ce175eb631a55bdfe50cf245869c9542279;hb=7555c945f91caaf7a4d7deb8a24bea616f426503;hp=aac78907f49a9090565fd5081dcbbe80ce86b777;hpb=89ab1e76dcec501c646d5b0158441c73923ec5fb;p=spider.git diff --git a/perl/Prefix.pm b/perl/Prefix.pm index aac78907..da173ce1 100644 --- a/perl/Prefix.pm +++ b/perl/Prefix.pm @@ -41,7 +41,7 @@ sub init # 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(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/; @@ -76,15 +76,20 @@ sub load } # tie the main prefix database - $db = tie(%pre, "DB_File", undef, O_RDWR|O_CREAT, 0664, $DB_BTREE) or confess "can't tie \%pre ($!)"; - my $out = $@ if $@; - do "$main::data/prefix_data.pl" if !$out; - $out = $@ if $@; + 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; }; + $out .= $@ if $@; $lru = LRU->newbase('Prefix', $lrusize); return $out; } +sub loaded +{ + return $db; +} + sub store { my ($k, $l); @@ -468,6 +473,23 @@ sub to_ciz return @out; } +# get the full country data (dxcc, itu, cq, state, city) as a list +# from a callsign. +sub cty_data +{ + my $call = shift; + + my @dxcc = extract($call); + if (@dxcc) { + my $state = $dxcc[1]->state || ''; + my $city = $dxcc[1]->city || ''; + my $name = $dxcc[1]->name || ''; + + return ($dxcc[1]->dxcc, $dxcc[1]->itu, $dxcc[1]->cq, $state, $city, $name); + } + return (666,0,0,'','','Pirate-Country-QQ'); +} + my %valid = ( lat => '0,Latitude,slat', long => '0,Longitude,slong',