From: Dirk Koopman <djk@tobit.co.uk>
Date: Mon, 8 Jun 2020 16:19:11 +0000 (+0100)
Subject: Merge branch 'mojo' into users.v3j
X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?p=spider.git;a=commitdiff_plain;h=86d0e8cc034db0b0d23afc09b6f596c38a57885d;hp=-c

Merge branch 'mojo' into users.v3j

just to keep stuff ticking along
---

86d0e8cc034db0b0d23afc09b6f596c38a57885d
diff --combined perl/DXUser.pm
index 02ed86cd,5d212b07..454432d1
--- a/perl/DXUser.pm
+++ b/perl/DXUser.pm
@@@ -17,9 -17,6 +17,9 @@@ 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 strict;
  
@@@ -30,13 -27,11 +30,13 @@@ $dbm = undef
  $filename = undef;
  $lastoperinterval = 60*24*60*60;
  $lasttime = 0;
- $lrusize = 3000;
+ $lrusize = 10000;
  $tooold = 86400 * 365;		# this marks an old user who hasn't given enough info to be useful
  $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',
@@@ -49,6 -44,7 +49,7 @@@
  		  email => '0,E-mail Address,parray',
  		  priv => '9,Privilege Level',
  		  lastin => '0,Last Time in,cldatetime',
+ 		  lastseen => '0,Last Seen,cldatetime',
  		  passwd => '9,Password,yesno',
  		  passphrase => '9,Pass Phrase,yesno',
  		  addr => '0,Full Address',
@@@ -132,34 -128,73 +133,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;
 -	}
 -	
 -	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?]";
 +	$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;
  	}
 -
 -	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";
  }
  
  #
@@@ -179,6 -214,7 +180,7 @@@ sub proces
  
  sub finish
  {
+ 	$dbm->sync;
  	undef $dbm;
  	untie %u;
  }
@@@ -204,6 -240,7 +206,7 @@@ sub ne
  #	confess "can't create existing call $call in User\n!" if $u{$call};
  
  	my $self = $pkg->alloc($call);
+ 	$self->{lastseen} = $main::systime;
  	$self->put;
  	return $self;
  }
@@@ -220,7 -257,10 +223,10 @@@ sub ge
  	
  	# is it in the LRU cache?
  	my $ref = $lru->get($call);
- 	return $ref if $ref && ref $ref eq 'DXUser';
+ 	if ($ref && ref $ref eq 'DXUser') {
+ 		$ref->{lastseen} = $main::systime;
+ 		return $ref;
+ 	}
  	
  	# search for it
  	unless ($dbm->get($call, $data)) {
@@@ -240,6 -280,7 +246,7 @@@
  			}
  			return undef;
  		}
+ 		$ref->{lastseen} = $main::systime;
  		$lru->put($call, $ref);
  		return $ref;
  	}
@@@ -296,31 -337,60 +303,31 @@@ 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);
 -	} else {
 -		$p = dd($self);
 -	}
 -	return $p;
 +    my $ref = shift;
 +    unbless($ref);
 +    my $s = $json->encode($ref);
 +    bless $ref, 'DXUser';
 +    return $s;
  }
  
 -#
 -# 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
@@@ -343,7 -413,7 +350,7 @@@ sub clos
  	my $self = shift;
  	my $startt = shift;
  	my $ip = shift;
- 	$self->{lastin} = $main::systime;
+ 	$self->{lastseen} = $self->{lastin} = $main::systime;
  	# add a record to the connect list
  	my $ref = [$startt || $self->{startt}, $main::systime];
  	push @$ref, $ip if $ip;
@@@ -377,10 -447,10 +384,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";
@@@ -389,7 -459,6 +396,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;
@@@ -433,39 -502,35 +440,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";
  
@@@ -495,7 -560,7 +502,7 @@@
  					}
  				}
  				# 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$@");
@@@ -506,8 -571,7 +513,8 @@@
  		} 
          $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;
  }