From: Dirk Koopman <djk@tobit.co.uk>
Date: Sun, 28 Jun 2020 14:14:44 +0000 (+0100)
Subject: Merge branch 'mojo' into users.v3j
X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=dd73f6f34ce7f3e142e480dfb7153611d87f509b;p=spider.git

Merge branch 'mojo' into users.v3j

Also convert QSL.pm and create_qsl.pl to JSON format.
---

dd73f6f34ce7f3e142e480dfb7153611d87f509b
diff --cc perl/DXUser.pm
index f78c8120,0b72a680..1249b0b6
--- a/perl/DXUser.pm
+++ b/perl/DXUser.pm
@@@ -17,9 -17,6 +17,10 @@@ use DXDebug
  use DXUtil;
  use LRU;
  use File::Copy;
 +use Data::Structure::Util qw(unbless);
 +use Time::HiRes qw(gettimeofday tv_interval);
 +use IO::File;
++use JSON;
  
  use strict;
  
@@@ -508,12 -561,12 +510,12 @@@ print "There are $count user records an
  					}
  				}
  				# only store users that are reasonably active or have useful information
 -				print $fh "$key\t" . $ref->asc_encode($basic_info_only) . "\n";
 +				print $fh "$key\t" . encode($ref) . "\n";
  				++$count;
  			} else {
- 				LogDbg('DXCommand', "Export Error3: $key\t" . carp($val) ."\n$@");
+ 				LogDbg('DXCommand', "Export Error3: '$key'\t" . carp($val) ."\n$@");
  				eval {$dbm->del($key)};
- 				dbg(carp("Export Error3: $key\t$val\n$@")) if $@;
+ 				dbg(carp("Export Error3: delete '$key' => '$val' $@")) if $@;
  				++$err;
  			}
  		} 
diff --cc perl/QSL.pm
index 0df7570b,0df7570b..e303e123
--- a/perl/QSL.pm
+++ b/perl/QSL.pm
@@@ -8,37 -8,37 +8,33 @@@
  package QSL;
  
  use strict;
--use DXVars;
++use SysVar;
  use DXUtil;
  use DB_File;
  use DXDebug;
  use Prefix;
++use JSON;
++use Data::Structure::Util qw(unbless);
  
  use vars qw($qslfn $dbm $maxentries);
--$qslfn = 'qsl';
++$qslfn = 'dxqsl';
  $dbm = undef;
  $maxentries = 50;
  
--localdata_mv("$qslfn.v1");
++my $json;
++
++localdata_mv("$qslfn.v1j");
  
  sub init
  {
  	my $mode = shift;
--	my $ufn = localdata("$qslfn.v1");
++	my $ufn = localdata("$qslfn.v1j");
  
--	Prefix::load() unless Prefix::loaded();
++	$json = JSON->new->canonical(1);
  	
--	eval {
--		require Storable;
--	};
++	Prefix::load() unless Prefix::loaded();
  	
--	if ($@) {
--		dbg("Storable appears to be missing");
--		dbg("In order to use the QSL feature you must");
--		dbg("load Storable from CPAN");
--		return undef;
--	}
--	import Storable qw(nfreeze freeze thaw);
++
  	my %u;
  	undef $dbm;
  	if ($mode) {
@@@ -119,7 -119,7 +115,7 @@@ sub ge
  	
  	my $r = $dbm->get($key, $value);
  	return undef if $r;
--	return thaw($value);
++	return decode($value);
  }
  
  sub put
@@@ -127,8 -127,8 +123,40 @@@
  	return unless $dbm;
  	my $self = shift;
  	my $key = $self->[0];
--	my $value = nfreeze($self);
++	my $value = encode($self);
  	$dbm->put($key, $value);
  }
  
++sub remove_files
++{
++	unlink "$main::data/qsl.v1j";
++	unlink "$main::local_data/qsl.v1j";
++}
++
++# thaw the user
++sub decode
++{
++    my $s = shift;
++    my $ref;
++    eval { $ref = $json->decode($s) };
++    if ($ref && !$@) {
++        return bless $ref, 'QSL';
++    } 
++    return undef;
++}
++
++# freeze the user
++sub encode
++{
++    my $ref = shift;
++    unbless($ref);
++    my $s;
++	
++	eval {$s = $json->encode($ref) };
++	if ($s && !$@) {
++		bless $ref, 'QSL';
++		return $s;
++	} 
++}
++
  1;
diff --cc perl/create_qsl.pl
index f4083f55,f4083f55..38fccc5a
--- a/perl/create_qsl.pl
+++ b/perl/create_qsl.pl
@@@ -32,13 -32,13 +32,11 @@@ use vars qw($end $lastyear $lastday $la
  $end = 0;
  $SIG{TERM} = $SIG{INT} = sub { $end++ };
  
--my $qslfn = "qsl";
++my $qslfn = "dxqsl";
  
  $main::systime = time;
  
--unlink "$data/qsl.v1";
--unlink "$local_data/qsl.v1";
--
++QSL::remove_files();
  QSL::init(1) or die "cannot open QSL file";
  
  my $base = localdata("spots");