X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FUSDB.pm;h=2ecb8ce015af736d1d923700018698a196aac522;hb=a2f8a91ca76dce4ec7649470d5fa1e2881682d42;hp=cba7ddb96c96f6b783e9e4f6db3e168f4e0f2184;hpb=973a2853ac360d77e8bc6382450c0a9e11da1f52;p=spider.git diff --git a/perl/USDB.pm b/perl/USDB.pm index cba7ddb9..2ecb8ce0 100644 --- a/perl/USDB.pm +++ b/perl/USDB.pm @@ -10,20 +10,18 @@ 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 $dbfn); -$dbfn = "$main::data/usdb.v1"; +localdata_mv("usdb.v1"); +$dbfn = localdata("usdb.v1"); sub init { @@ -123,9 +121,10 @@ sub load my %dbn; if (-e $dbfn ) { - copy($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 @@ -133,6 +132,8 @@ sub load for (@_) { 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 @@ -141,7 +142,7 @@ sub load if ($nfn =~ /.gz$/i) { my $gz; eval qq{use Compress::Zlib; \$gz = gzopen(\$ofn, "rb")}; - return "Cannot read compressed files $@" if $@; + 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);