X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FPrefix.pm;h=68a5d65619080fc1b3bebc613b8496928de7c303;hb=ba5625a459d1418cdc05591ae556df58d509ac9d;hp=aac78907f49a9090565fd5081dcbbe80ce86b777;hpb=89ab1e76dcec501c646d5b0158441c73923ec5fb;p=spider.git diff --git a/perl/Prefix.pm b/perl/Prefix.pm index aac78907..68a5d656 100644 --- a/perl/Prefix.pm +++ b/perl/Prefix.pm @@ -3,7 +3,7 @@ # # Copyright (c) - Dirk Koopman G1TLH # -# $Id$ +# # package Prefix; @@ -19,12 +19,6 @@ use LRU; use strict; -use vars qw($VERSION $BRANCH); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; - use vars qw($db %prefix_loc %pre $lru $lrusize $misses $hits $matchtotal); $db = undef; # the DB_File handle @@ -41,7 +35,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 +70,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 +467,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',