]> dxcluster.net Git - spider.git/blob - perl/USDB.pm
push non-pc9x and non-spider nodes back for routing
[spider.git] / 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(%db $present $dbfn);
19
20 $dbfn = "$main::data/usdb.v1";
21
22 sub init
23 {
24         end();
25         if (tie %db, 'DB_File', $dbfn, O_RDWR, 0664, $DB_BTREE) {
26                 $present = 1;
27                 return "US Database loaded";
28         }
29         return "US Database not loaded";
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 _add
48 {
49         my ($db, $call, $city, $state) = @_;
50         
51         # lookup the city 
52         my $s = uc "$city|$state";
53         my $ctyn = $db->{$s};
54         unless ($ctyn) {
55                 my $no = $db->{'##'} || 1;
56                 $ctyn = "#$no";
57                 $db->{$s} = $ctyn;
58                 $db->{$ctyn} = $s; 
59                 $no++;
60                 $db->{'##'} = "$no";
61         }
62         $db->{uc $call} = $ctyn; 
63 }
64
65 sub add
66 {
67         _add(\%db, @_);
68 }
69
70 sub getstate
71 {
72         return () unless $present;
73         my @s = get($_[0]);
74         return @s ? $s[1] : undef;
75 }
76
77 sub getcity
78 {
79         return () unless $present;
80         my @s = get($_[0]);
81         return @s ? $s[0] : undef;
82 }
83
84 sub del
85 {
86         my $call = uc shift;
87         delete $db{$call};
88 }
89
90 #
91 # load in / update an existing DB with a standard format (GZIPPED)
92 # "raw" file.
93 #
94 # Note that this removes and overwrites the existing DB file
95 # You will need to init again after doing this
96
97
98 sub load
99 {
100         return "Need a filename" unless @_;
101         
102         # create the new output file
103         my $a = new DB_File::BTREEINFO;
104         $a->{psize} = 4096 * 2;
105         my $s = 0;
106
107         # guess a cache size
108         for (@_) {
109                 my $ts = -s;
110                 $s = $ts if $ts > $s;
111         }
112         if ($s > 1024 * 1024) {
113                 $a->{cachesize} = int($s / (1024*1024)) * 3 * 1024 * 1024;
114         }
115
116 #       print "cache size " . $a->{cachesize} . "\n";
117         
118         my %dbn;
119         if (-e $dbfn ) {
120                 copy($dbfn, "$dbfn.new") or return "cannot copy $dbfn -> $dbfn.new $!";
121         }
122         
123         tie %dbn, 'DB_File', "$dbfn.new", O_RDWR|O_CREAT, 0664, $a or return "cannot tie $dbfn.new $!";
124         
125         # now write away all the files
126         my $count = 0;
127         for (@_) {
128                 my $ofn = shift;
129
130                 return "Cannot find $ofn" unless -r $ofn;
131                 
132                 # conditionally handle compressed files (don't cha just lurv live code, this is
133                 # a rave from the grave and is "in memoriam Flossie" the ICT 1301G I learnt on.
134                 # {for pedant computer historians a 1301G is an ICT 1301A that has been 
135                 # Galdorised[tm] (for instance had decent IOs and a 24 pre-modify instruction)}
136                 my $nfn = $ofn;
137                 if ($nfn =~ /.gz$/i) {
138                         my $gz;
139                         eval qq{use Compress::Zlib; \$gz = gzopen(\$ofn, "rb")};
140                         return "Cannot read compressed files $@ $!" if $@ || !$gz;
141                         $nfn =~ s/.gz$//i;
142                         my $of = new IO::File ">$nfn" or return "Cannot write to $nfn $!";
143                         my ($l, $buf);
144                         $of->write($buf, $l) while ($l = $gz->gzread($buf));
145                         $gz->gzclose;
146                         $of->close;
147                         $ofn = $nfn;
148                 }
149
150                 my $of = new IO::File "$ofn" or return "Cannot read $ofn $!";
151
152                 while (<$of>) {
153                         my $l = $_;
154                         $l =~ s/[\r\n]+$//;
155                         my ($call, $city, $state) = split /\|/, $l;
156
157                         _add(\%dbn, $call, $city, $state);
158                         
159                         $count++;
160                 }
161                 $of->close;
162                 unlink $nfn;
163         }
164         
165         untie %dbn;
166         rename "$dbfn.new", $dbfn;
167         return "$count records";
168 }
169
170 1;