fix missing callsigns
authorminima <minima>
Tue, 15 Oct 2002 00:37:14 +0000 (00:37 +0000)
committerminima <minima>
Tue, 15 Oct 2002 00:37:14 +0000 (00:37 +0000)
add back compressed handling

Changes
cmd/load/usdb.pl
perl/USDB.pm
perl/create_usdb.pl
perl/gen_usdb_data.pl

diff --git a/Changes b/Changes
index 524b2ade085ea0cdf60d3a53ce021b2a1bb338de..111fe642c5b54a06e5945777011986c2eed2a148 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,9 @@
+15Oct02=======================================================================
+1. made some detail changes to the raw USDB data and the routines that 
+generate and operate on them. There were some bugs involving a few 'missing'
+callsigns which been fixed. Also there were some, for our purposes, invalid
+callsigns in the database which have been removed (down to about 820,000 
+entries now). You should really update your database. 
 14Oct02=======================================================================
 1. added show/usdb command as a simple, direct interface to the information
 available in the USDB stuff.
index bd45547d106e8d5cd7c52a8fd054c58d7c4afe89..b06f7c51b64eea0332ecb43054dddc7de4dcbfad 100644 (file)
@@ -15,9 +15,6 @@
 my ($self, $line) = @_;
 my @out;
 return (1, $self->msg('e5')) if $self->priv < 9;
-return (1, $self->msg('e3', "load/usdb", $line)) if $line && !-r $line;
-$line = "$main::data/usdbraw" unless $line;
-push @out, (USDB::load($line));
-USDB::init() unless @OUT;
-@out = ($self->msg('ok')) unless @out;
+my $r = USDB::load($line) if $line;
+USDB::init() if undef $r || $r =~ /^\d+ rec/;
 return (1, @out); 
index 14f9fc2ec49fa860b8107728a5414847d9eb5d9a..69e1ead083446e4fbf3fa5c43900299c1418aee9 100644 (file)
@@ -101,8 +101,28 @@ sub load
        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 $ofn = shift;
+
+               # 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 $@;
+                       $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>) {
@@ -122,14 +142,15 @@ sub load
                                $dbn{'##'} = "$no";
                        }
                        $dbn{$call} = $ctyn; 
+                       $count++;
                }
                $of->close;
-               unlink $ofn;
+               unlink $nfn;
        }
        
        untie %dbn;
        rename "$dbfn.new", $dbfn;
-       return ();
+       return "$count records";
 }
 
 1;
index a0da7ff413e75aea5619487273d8d8e9c4452645..575babc7b42ad50585a560d9c9b6bad2f850e9d7 100755 (executable)
@@ -30,7 +30,7 @@ use USDB;
 
 die "no input (usdbraw?) files specified\n" unless @ARGV;
 
-USDB::load(@ARGV);
+print "\n", USDB::load(@ARGV), "\n";
 exit(0);
 
 
index cc2850cf693fa6c6c9f1bf04f17cc0ef0de2e5c5..71101bec228df8acc42a1082f514022404bf9009 100755 (executable)
@@ -73,7 +73,6 @@ foreach my $argv (@ARGV) {
 }
 
 $gzfh->gzclose;
-print "$ctycount Cities found\n";
 
 exit(0);
 
@@ -96,19 +95,20 @@ sub handleEN
                                $l =~ s/[\r\n]+$//;
                                my ($rt,$usi,$ulsfn,$ebfno,$call,$type,$lid,$name,$first,$middle,$last,$suffix,
                                        $phone,$fax,$email,$street,$city,$state,$zip,$pobox,$attl,$sgin,$frn) = split /\|/, $l;
-                               
-                               my $rec = uc join '|', $call,$city,$state if $city && $state;
-                               $buf .= "$rec\n";
-                               if (length $buf > $blksize) {
-                                       $gzfh->gzwrite($buf);
-                                       undef $buf;
+
+#                              print "ERR: $l\n" unless $call && $city && $state;
+
+                               if ($call && $city && $state) {
+                                       my $rec = uc join '|', $call,$city,$state if $city && $state;
+                                       $buf .= "$rec\n";
+                                       if (length $buf > $blksize) {
+                                               $gzfh->gzwrite($buf);
+                                               undef $buf;
+                                       }
+                                       $count++;
                                }
-                               my $c = uc "$city|$state";
-                               $count++;
-                       }
-                       if (length $buf > $blksize) {
-                               $gzfh->gzwrite($buf);
                        }
+                       $gzfh->gzwrite($buf) if length $buf;
                        print ", $count records\n";
                        $fh->close;
                }