X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FUSDB.pm;h=2ecb8ce015af736d1d923700018698a196aac522;hb=a4ec795f9648328dc8b22efec8f0b2516671c3e3;hp=3b62fa5d59c5d995b5371a1e4c4a4e9460533b95;hpb=08912ec52dee25bbe00aef10387e1822dcd574bc;p=spider.git

diff --git a/perl/USDB.pm b/perl/USDB.pm
index 3b62fa5d..2ecb8ce0 100644
--- a/perl/USDB.pm
+++ b/perl/USDB.pm
@@ -5,28 +5,32 @@
 #
 # 
 
+package USDB;
+
 use strict;
 
 use DXVars;
+use SysVar;
 use DB_File;
 use File::Copy;
 use DXDebug;
-use Compress::Zlib;
+use DXUtil;
 
-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 Compress::Zlib;
 
-use vars qw(%db $present);
+use vars qw(%db $present $dbfn);
 
-my $dbfn = "$main::data/usdb.v1";
+localdata_mv("usdb.v1");
+$dbfn = localdata("usdb.v1");
 
 sub init
 {
 	end();
-	tie %db, 'DB_File', $dbfn and $present = 1;
+	if (tie %db, 'DB_File', $dbfn, O_RDWR, 0664, $DB_BTREE) {
+		$present = 1;
+		return "US Database loaded";
+	}
+	return "US Database not loaded";
 }
 
 sub end
@@ -44,6 +48,29 @@ sub get
 	return @s;
 }
 
+sub _add
+{
+	my ($db, $call, $city, $state) = @_;
+	
+	# lookup the city 
+	my $s = uc "$city|$state";
+	my $ctyn = $db->{$s};
+	unless ($ctyn) {
+		my $no = $db->{'##'} || 1;
+		$ctyn = "#$no";
+		$db->{$s} = $ctyn;
+		$db->{$ctyn} = $s; 
+		$no++;
+		$db->{'##'} = "$no";
+	}
+	$db->{uc $call} = $ctyn; 
+}
+
+sub add
+{
+	_add(\%db, @_);
+}
+
 sub getstate
 {
 	return () unless $present;
@@ -58,56 +85,91 @@ sub getcity
 	return @s ? $s[0] : undef;
 }
 
+sub del
+{
+	my $call = uc shift;
+	delete $db{$call};
+}
+
 #
 # load in / update an existing DB with a standard format (GZIPPED)
 # "raw" file.
 #
 # Note that this removes and overwrites the existing DB file
 # You will need to init again after doing this
-#
+# 
 
 sub load
 {
+	return "Need a filename" unless @_;
+	
 	# create the new output file
 	my $a = new DB_File::BTREEINFO;
 	$a->{psize} = 4096 * 2;
-	my $s;
-	if ($s = -s $dbfn && $s > 1024 * 1024) {
-		$a->{cachesize} = int(($s / (1024*1024)) / 2) * 1024 * 1024;
+	my $s = 0;
+
+	# guess a cache size
+	for (@_) {
+		my $ts = -s;
+		$s = $ts if $ts > $s;
 	}
+	if ($s > 1024 * 1024) {
+		$a->{cachesize} = int($s / (1024*1024)) * 3 * 1024 * 1024;
+	}
+
+#	print "cache size " . $a->{cachesize} . "\n";
+	
 	my %dbn;
 	if (-e $dbfn ) {
-		syscopy($dbfn, "$dbfn.new") or return "cannot copy $dbfn -> $dbfn.new $!";
+		copy($dbfn, "$dbfn.old") or return "cannot copy $dbfn -> $dbfn.old $!";
 	}
-	
+
+	unlink "$dbfn.new";
 	tie %dbn, 'DB_File', "$dbfn.new", O_RDWR|O_CREAT, 0664, $a or return "cannot tie $dbfn.new $!";
 	
 	# now write away all the files
+	my $count = 0;
 	for (@_) {
-		my $fn = shift;
-		my $f = gzopen($fn, "r") or return "Cannot open $fn $!";
-		while ($f->gzreadline) {
-			chomp;
-			my ($call, $city, $state) = split /\|/;
+		my $ofn = shift;
+
+		return "Cannot find $ofn" unless -r $ofn;
+		
+		# conditionally handle compressed files (don't cha just lurv live code, this is
+		# a rave from the grave and is "in memoriam Flossie" the ICT 1301G I learnt on.
+		# {for pedant computer historians a 1301G is an ICT 1301A that has been 
+		# Galdorised[tm] (for instance had decent IOs and a 24 pre-modify instruction)}
+		my $nfn = $ofn;
+		if ($nfn =~ /.gz$/i) {
+			my $gz;
+			eval qq{use Compress::Zlib; \$gz = gzopen(\$ofn, "rb")};
+			return "Cannot read compressed files $@ $!" if $@ || !$gz;
+			$nfn =~ s/.gz$//i;
+			my $of = new IO::File ">$nfn" or return "Cannot write to $nfn $!";
+			my ($l, $buf);
+			$of->write($buf, $l) while ($l = $gz->gzread($buf));
+			$gz->gzclose;
+			$of->close;
+			$ofn = $nfn;
+		}
+
+		my $of = new IO::File "$ofn" or return "Cannot read $ofn $!";
+
+		while (<$of>) {
+			my $l = $_;
+			$l =~ s/[\r\n]+$//;
+			my ($call, $city, $state) = split /\|/, $l;
+
+			_add(\%dbn, $call, $city, $state);
 			
-			# lookup the city 
-			my $s = "$city|$state";
-			my $ctyn = $dbn{$s};
-			unless ($ctyn) {
-				my $no = $dbn{'##'} || 1;
-				$ctyn = "#$no";
-				$dbn{$s} = $ctyn;
-				$dbn{$ctyn} = $s; 
-				$no++;
-				$dbn{'##'} = "$no";
-			}
-			$dbn{$call} = $ctyn; 
+			$count++;
 		}
-		$f->gzclose;
+		$of->close;
+		unlink $nfn;
 	}
 	
 	untie %dbn;
 	rename "$dbfn.new", $dbfn;
+	return "$count records";
 }
 
 1;