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