perl/USDB.pm

   1 #
   2 # Package to handle US Callsign -> City, State translations
   3 #
   4 # Copyright (c) 2002 Dirk Koopman G1TLH
   5 #
   6 #
   7
   8 package USDB;
   9
  10 use strict;
  11
  12 use DXVars;
  13 use DB_File;
  14 use File::Copy;
  15 use DXDebug;
  16 use Compress::Zlib;
  17
  18 use vars qw($VERSION $BRANCH);
  19 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
  20 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
  21 $main::build += $VERSION;
  22 $main::branch += $BRANCH;
  23
  24 use vars qw(%db $present $dbfn);
  25
  26 $dbfn = "$main::data/usdb.v1";
  27
  28 sub init
  29 {
  30         end();
  31         tie %db, 'DB_File', $dbfn and $present = 1;
  32 }
  33
  34 sub end
  35 {
  36         return unless $present;
  37         untie %db;
  38         undef $present;
  39 }
  40
  41 sub get
  42 {
  43         return () unless $present;
  44         my $ctyn = $db{$_[0]};
  45         my @s = split /\|/, $db{$ctyn} if $ctyn;
  46         return @s;
  47 }
  48
  49 sub getstate
  50 {
  51         return () unless $present;
  52         my @s = get($_[0]);
  53         return @s ? $s[1] : undef;
  54 }
  55
  56 sub getcity
  57 {
  58         return () unless $present;
  59         my @s = get($_[0]);
  60         return @s ? $s[0] : undef;
  61 }
  62
  63 #
  64 # load in / update an existing DB with a standard format (GZIPPED)
  65 # "raw" file.
  66 #
  67 # Note that this removes and overwrites the existing DB file
  68 # You will need to init again after doing this
  69 #
  70
  71 sub load
  72 {
  73         return "Need a filename" unless @_;
  74
  75         # create the new output file
  76         my $a = new DB_File::BTREEINFO;
  77         $a->{psize} = 4096 * 2;
  78         my $s = 0;
  79
  80         # guess a cache size
  81         for (@_) {
  82                 my $ts = -s;
  83                 $s = $ts if $ts > $s;
  84         }
  85         if ($s > 1024 * 1024) {
  86                 $a->{cachesize} = int($s / (1024*1024)) * 3 * 1024 * 1024;
  87         }
  88
  89 #       print "cache size " . $a->{cachesize} . "\n";
  90
  91         my %dbn;
  92         if (-e $dbfn ) {
  93                 syscopy($dbfn, "$dbfn.new") or return "cannot copy $dbfn -> $dbfn.new $!";
  94         }
  95
  96         tie %dbn, 'DB_File', "$dbfn.new", O_RDWR|O_CREAT, 0664, $a or return "cannot tie $dbfn.new $!";
  97
  98         # now write away all the files
  99         for (@_) {
 100                 my $fn = shift;
 101                 my $f = gzopen($fn, "r") or return "Cannot open $fn $!";
 102                 my $l;
 103                 while ($f->gzreadline($l)) {
 104                         chomp $l;
 105                         my ($call, $city, $state) = split /\|/, $l;
 106
 107                         # lookup the city
 108                         my $s = "$city|$state";
 109                         my $ctyn = $dbn{$s};
 110                         unless ($ctyn) {
 111                                 my $no = $dbn{'##'} || 1;
 112                                 $ctyn = "#$no";
 113                                 $dbn{$s} = $ctyn;
 114                                 $dbn{$ctyn} = $s;
 115                                 $no++;
 116                                 $dbn{'##'} = "$no";
 117                         }
 118                         $dbn{$call} = $ctyn;
 119                 }
 120                 $f->gzclose;
 121         }
 122
 123         untie %dbn;
 124         rename "$dbfn.new", $dbfn;
 125 }
 126
 127 1;