Merge branch 'mojo' into users.v3j

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

diff --combined perl/DXUser.pm
index f78c8120181bfd39889e4be48a7b90ca60c4e9c6,0b72a680f363a4bbcf45f6912217c110ccec5f6b..1249b0b69f8842f323d13ff245a68774fcc7e452
--- 1/perl/DXUser.pm
--- 2/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;
  
@@@ -35,8 -32,6 +36,8 @@@ $tooold = 86400 * 365;                # this marks a
  $v3 = 0;
  our $maxconnlist = 3;                 # remember this many connection time (duration) [start, end] pairs
  
 +my $json;
 +
  # hash of valid elements and a simple prompt
  %valid = (
                  call => '0,Callsign',
@@@ -106,6 -101,7 +107,7 @@@
                  maxconnect => '1,Max Connections',
                  startt => '0,Start Time,cldatetime',
                  connlist => '1,Connections,parraydifft',
+                 width => '0,Preferred Width'
                 );
  
  #no strict;
@@@ -133,34 -129,73 +135,34 @@@ sub ini
  {
        my $mode = shift;
    
 -      my $ufn;
 -      my $convert;
 -      
 -      eval {
 -              require Storable;
 -      };
 -
 +   $json = JSON->new->canonical(1);
        my $fn = "users";
 -      
 -      if ($@) {
 -              $ufn = localdata("users.v2");
 -              $v3 = $convert = 0;
 -              dbg("the module Storable appears to be missing!!");
 -              dbg("trying to continue in compatibility mode (this may fail)");
 -              dbg("please install Storable from CPAN as soon as possible");
 -      } else {
 -              import Storable qw(nfreeze thaw);
 -
 -              $ufn = localdata("users.v3");
 -              $v3 = 1;
 -              $convert++ if -e localdata("users.v2") && !-e $ufn;
 +      $filename = localdata("$fn.v3j");
 +      unless (-e $filename || $mode == 2) {
 +              LogDbg('DXUser', "New User File version $filename does not exist, running conversion from users.v3 or v2, please wait");
 +              system('/spider/perl/convert-users-v3-to-v3j.pl');
 +              init(1);
 +              export();
 +              return;
        }
 -      
 -      if ($mode) {
 -              $dbm = tie (%u, 'DB_File', $ufn, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_asc?]";
 -      } else {
 -              $dbm = tie (%u, 'DB_File', $ufn, O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_asc?]";
 -      }
 -
 -      die "Cannot open $ufn ($!)\n" unless $dbm;
 -
 -      $lru = LRU->newbase("DXUser", $lrusize);
 -      
 -      # do a conversion if required
 -      if ($dbm && $convert) {
 -              my ($key, $val, $action, $count, $err) = ('','',0,0,0);
 -              
 -              my %oldu;
 -              dbg("Converting the User File to V3 ");
 -              dbg("This will take a while, I suggest you go and have cup of strong tea");
 -              my $odbm = tie (%oldu, 'DB_File', localdata("users.v2"), O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn.v2 ($!) [rebuild it from user_asc?]";
 -        for ($action = R_FIRST; !$odbm->seq($key, $val, $action); $action = R_NEXT) {
 -                      my $ref;
 -                      eval { $ref = asc_decode($val) };
 -                      unless ($@) {
 -                              if ($ref) {
 -                                      $ref->put;
 -                                      $count++;
 -                              } else {
 -                                      $err++
 -                              }
 -                      } else {
 -                              Log('err', "DXUser: error decoding $@");
 -                      }
 -              } 
 -              undef $odbm;
 -              untie %oldu;
 -              dbg("Conversion completed $count records $err errors");
 +      if (-e $filename || $mode == 2) {
 +              $lru = LRU->newbase("DXUser", $lrusize);
 +              if ($mode) {
 +                      $dbm = tie (%u, 'DB_File', $filename, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_json?]";
 +              } else {
 +                      $dbm = tie (%u, 'DB_File', $filename, O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_json?]";
 +              }
        }
 -      $filename = $ufn;
 +      die "Cannot open $filename ($!)\n" unless $dbm || $mode == 2;
 +      return;
  }
  
 +# delete files with extreme prejudice
  sub del_file
  {
        # with extreme prejudice
 -      unlink "$main::data/users.v3";
 -      unlink "$main::local_data/users.v3";
 +      unlink "$main::data/users.v3j";
 +      unlink "$main::local_data/users.v3j";
  }
  
  #
@@@ -303,37 -338,60 +305,37 @@@ sub pu
        $dbm->put($call, $ref);
  }
  
 -# freeze the user
 -sub encode
 -{
 -      goto &asc_encode unless $v3;
 -      my $self = shift;
 -      return nfreeze($self);
 -}
  
  # thaw the user
  sub decode
  {
 -      goto &asc_decode unless $v3;
 -      my $ref;
 -      $ref = thaw(shift);
 -      return $ref;
 +    my $s = shift;
 +    my $ref;
 +    eval { $ref = $json->decode($s) };
 +    if ($ref && !$@) {
 +        return bless $ref, 'DXUser';
 +    } else {
 +        LogDbg('DXUser', "DXUser::json_decode: on '$s' $@");
 +    }
 +    return undef;
  }
  
 -# 
 -# create a string from a user reference (in_ascii)
 -#
 -sub asc_encode
 +# freeze the user
 +sub encode
  {
 -      my $self = shift;
 -      my $strip = shift;
 -      my $p;
 -
 -      if ($strip) {
 -              my $ref = bless {}, ref $self;
 -              foreach my $k (qw(qth lat long qra sort call homenode node lastoper lastin)) {
 -                      $ref->{$k} = $self->{$k} if exists $self->{$k};
 -              }
 -              $ref->{name} = $self->{name} if exists $self->{name} && $self->{name} !~ /selfspot/i;
 -              $p = dd($ref);
 +    my $ref = shift;
 +    unbless($ref);
 +    my $s;
 +      
 +      eval {$s = $json->encode($ref) };
 +      if ($s && !$@) {
 +              bless $ref, 'DXUser';
 +              return $s;
        } else {
 -              $p = dd($self);
 +              LogDbg('DXUser', "DXUser::json_encode $ref->{call}, $@");
        }
 -      return $p;
  }
  
 -#
 -# create a hash from a string (in ascii)
 -#
 -sub asc_decode
 -{
 -      my $s = shift;
 -      my $ref;
 -      $s =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
 -      eval '$ref = ' . $s;
 -      if ($@) {
 -              LogDbg('err', "DXUser::asc_decode: on '$s' $@");
 -              $ref = undef;
 -      }
 -      return $ref;
 -}
  
  #
  # del - delete a user
@@@ -390,10 -448,10 +392,10 @@@ sub field
  
  sub export
  {
 -      my $name = shift || 'user_asc';
 +      my $name = shift || 'user_json';
        my $basic_info_only = shift;
  
 -      my $fn = $name ne 'user_asc' ? $name : "$main::local_data/$name";                       # force use of local
 +      my $fn = $name ne 'user_json' ? $name : "$main::local_data/$name";                       # force use of local
        
        # save old ones
        move "$fn.oooo", "$fn.ooooo" if -e "$fn.oooo";
@@@ -402,7 -460,6 +404,7 @@@
        move "$fn.o", "$fn.oo" if -e "$fn.o";
        move "$fn", "$fn.o" if -e "$fn";
  
 +      my $ta = [gettimeofday];
        my $count = 0;
        my $err = 0;
        my $del = 0;
@@@ -446,39 -503,35 +448,39 @@@ BEGIN 
  }
  
  use SysVar;
 +use DXUtil;
  use DXUser;
 +use JSON;
 +use Time::HiRes qw(gettimeofday tv_interval);
 +package DXUser;
  
 -if (@ARGV) {
 -      $main::userfn = shift @ARGV;
 -      print "user filename now $userfn\n";
 -}
 +our $json = JSON->new->canonical(1);
  
 -package DXUser;
 +my $ta = [gettimeofday];
 +our $filename = "$main::local_data/users.v3j";
 +my $exists = -e $filename ? "OVERWRITING" : "CREATING"; 
 +print "perl user_json $exists $filename\n";
  
  del_file();
 -init(1);
 +init(2);
  %u = ();
  my $count = 0;
  my $err = 0;
  while (<DATA>) {
        chomp;
        my @f = split /\t/;
 -      my $ref = asc_decode($f[1]);
 +      my $ref = decode($f[1]);
        if ($ref) {
                $ref->put();
                $count++;
 -        DXUser::sync() unless $count % 10000;
        } else {
                print "# Error: $f[0]\t$f[1]\n";
                $err++
        }
  }
  DXUser::sync(); DXUser::finish();
 -print "There are $count user records and $err errors\n";
 +my $diff = _diffms($ta);
 +print "There are $count user records and $err errors in $diff mS\n";
  };
                print $fh "__DATA__\n";
  
@@@ -487,10 -540,10 +489,10 @@@
                                my $eval = $val;
                                my $ekey = $key;
                                $eval =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; 
-                               $ekey =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; 
-                               LogDbg('DXCommand', "Export Error1: invalid callsign($ekey) => '$eval'");
+                               $ekey =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
+                               LogDbg('DXCommand', "Export Error1: invalid call '$key' => '$val'");
                                eval {$dbm->del($key)};
-                               dbg(carp("Export Error1: delete call $ekey => '$eval' $@")) if $@;
+                           dbg(carp("Export Error1: delete $key => '$val' $@")) if $@;
                                ++$err;
                                next;
                        }
@@@ -501,26 -554,25 +503,26 @@@
                                if ($ref->is_user && !$ref->{priv} && $main::systime > $t + $tooold) {
                                        unless ($ref->{lat} && $ref->{long} || $ref->{qth} || $ref->{qra}) {
                                                eval {$dbm->del($key)};
-                                               dbg(carp("Export Error2: delete $key => '$val' $@")) if $@;
+                                               dbg(carp("Export Error2: delete '$key' => '$val' $@")) if $@;
                                                LogDbg('DXCommand', "$ref->{call} deleted, too old");
                                                $del++;
                                                next;
                                        }
                                }
                                # 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;
                        }
                } 
          $fh->close;
      }
 -      my $s = qq{Exported users to $fn - $count Users $del Deleted $err Errors ('sh/log Export' for details)};
 +      my $diff = _diffms($ta);
 +      my $s = qq{Exported users to $fn - $count Users $del Deleted $err Errors in $diff mS ('sh/log Export' for details)};
        LogDbg('command', $s);
        return $s;
  }

diff --combined perl/QSL.pm
index 0df7570ba24f615ac1fccce38cde2d59955588ca,0df7570ba24f615ac1fccce38cde2d59955588ca..e303e123aaa1bedf87393cab649eb4b9a858b6fe
--- 1/perl/QSL.pm
--- 2/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 --combined perl/create_qsl.pl
index f4083f55d0adb7f1ec146f61e4f7b79bbe732255,f4083f55d0adb7f1ec146f61e4f7b79bbe732255..38fccc5a959e3c4af3ed6f8c979f7aa061670bb4
--- 1/perl/create_qsl.pl
--- 2/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");