X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FQSL.pm;h=ec5512216f563ffe9929bad57253d9d87851799f;hb=refs%2Fheads%2Fstaging;hp=e303e123aaa1bedf87393cab649eb4b9a858b6fe;hpb=dd73f6f34ce7f3e142e480dfb7153611d87f509b;p=spider.git diff --git a/perl/QSL.pm b/perl/QSL.pm index e303e123..ec551221 100644 --- a/perl/QSL.pm +++ b/perl/QSL.pm @@ -13,7 +13,7 @@ use DXUtil; use DB_File; use DXDebug; use Prefix; -use JSON; +use DXJSON; use Data::Structure::Util qw(unbless); use vars qw($qslfn $dbm $maxentries); @@ -21,6 +21,7 @@ $qslfn = 'dxqsl'; $dbm = undef; $maxentries = 50; +my %u; my $json; localdata_mv("$qslfn.v1j"); @@ -30,13 +31,12 @@ sub init my $mode = shift; my $ufn = localdata("$qslfn.v1j"); - $json = JSON->new->canonical(1); + $json = DXJSON->new; Prefix::load() unless Prefix::loaded(); - - my %u; - undef $dbm; + finish() if $dbm; + if ($mode) { $dbm = tie (%u, 'DB_File', $ufn, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open qsl file: $qslfn ($!)"; } else { @@ -47,7 +47,10 @@ sub init sub finish { + dbg("DXQSL finished"); + $dbm->sync; undef $dbm; + untie %u; } sub new @@ -118,6 +121,7 @@ sub get return decode($value); } + sub put { return unless $dbm; @@ -129,34 +133,28 @@ sub put sub remove_files { - unlink "$main::data/qsl.v1j"; - unlink "$main::local_data/qsl.v1j"; + unlink "$main::data/$qslfn.v1j"; + unlink "$main::local_data/$qslfn.v1j"; } # thaw the user sub decode { - my $s = shift; - my $ref; - eval { $ref = $json->decode($s) }; - if ($ref && !$@) { - return bless $ref, 'QSL'; - } - return undef; + return $json->decode($_[0], __PACKAGE__); } # freeze the user sub encode { - my $ref = shift; - unbless($ref); - my $s; - - eval {$s = $json->encode($ref) }; - if ($s && !$@) { - bless $ref, 'QSL'; - return $s; - } + return $json->encode($_[0]); +} + +sub END +{ + if ($dbm) { + dbg "DXQSL ENDing"; + finish(); + } } 1;