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