Merge branch 'mojo' into users.v3j
authorDirk Koopman <djk@tobit.co.uk>
Sun, 28 Jun 2020 14:14:44 +0000 (15:14 +0100)
committerDirk Koopman <djk@tobit.co.uk>
Sun, 28 Jun 2020 14:14:44 +0000 (15:14 +0100)
Also convert QSL.pm and create_qsl.pl to JSON format.

1  2 
perl/DXUser.pm
perl/QSL.pm
perl/create_qsl.pl

diff --cc perl/DXUser.pm
index f78c8120181bfd39889e4be48a7b90ca60c4e9c6,0b72a680f363a4bbcf45f6912217c110ccec5f6b..1249b0b69f8842f323d13ff245a68774fcc7e452
@@@ -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 0df7570ba24f615ac1fccce38cde2d59955588ca,0df7570ba24f615ac1fccce38cde2d59955588ca..e303e123aaa1bedf87393cab649eb4b9a858b6fe
@@@ -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
        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;
index f4083f55d0adb7f1ec146f61e4f7b79bbe732255,f4083f55d0adb7f1ec146f61e4f7b79bbe732255..38fccc5a959e3c4af3ed6f8c979f7aa061670bb4
@@@ -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");