X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=6ca9b91e5af7aff42fb73c28b08d220429194f11;hb=7858cc043933ba59f692637d6ef1d08b4c7b5681;hp=3df7fc20b218e42a2afb90da8fa03d0dec82cbf7;hpb=4f9aaa802abf523aab9e02e17809cdc17e6035f9;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 3df7fc20..6ca9b91e 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -78,8 +78,6 @@ $v3 = 0; wantlogininfo => '0,Login Info Req,yesno', wantgrid => '0,Show DX Grid,yesno', wantann_talk => '0,Talklike Anns,yesno', - wantpc90 => '1,Req PC90,yesno', - wantnp => '1,Req New Proto,yesno', wantpc16 => '9,Want Users from node,yesno', wantsendpc16 => '9,Send PC16,yesno', wantroutepc19 => '9,Route PC19,yesno', @@ -143,7 +141,7 @@ sub init $ufn = "$fn.v3"; $v3 = 1; - $convert++ unless -e $ufn; + $convert++ if -e "$fn.v2" && !-e $ufn; } if ($mode) { @@ -152,10 +150,12 @@ sub init $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 ($convert) { + if ($dbm && $convert) { my ($key, $val, $action, $count, $err) = ('','',0,0,0); my %oldu; @@ -212,17 +212,23 @@ sub finish # new - create a new user # -sub new +sub alloc { my $pkg = shift; my $call = uc shift; + my $self = bless {call => $call, 'sort'=>'U'}, $pkg; + return $self; +} + +sub new +{ + my $pkg = shift; + my $call = shift; # $call =~ s/-\d+$//o; # confess "can't create existing call $call in User\n!" if $u{$call}; - my $self = bless {}, $pkg; - $self->{call} = $call; - $self->{'sort'} = 'U'; + my $self = $pkg->alloc($call); $self->put; return $self; } @@ -338,8 +344,7 @@ sub asc_decode my $ref; eval '$ref = ' . $s; if ($@) { - dbg($@); - Log('err', $@); + LogDbg('err', $@); $ref = undef; } return $ref; @@ -486,7 +491,7 @@ print "There are $count user records and $err errors\n"; 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; - Log('DXCommand', "Export Error1: $ekey\t$eval"); + LogDbg('DXCommand', "Export Error1: $ekey\t$eval"); eval {$dbm->del($key)}; dbg(carp("Export Error1: $ekey\t$eval\n$@")) if $@; ++$err; @@ -499,7 +504,7 @@ print "There are $count user records and $err errors\n"; unless ($ref->{lat} && $ref->{long} || $ref->{qth} || $ref->{qra}) { eval {$dbm->del($key)}; dbg(carp("Export Error2: $key\t$val\n$@")) if $@; - Log('DXCommand', "$ref->{call} deleted, too old"); + LogDbg('DXCommand', "$ref->{call} deleted, too old"); $del++; next; } @@ -508,7 +513,7 @@ print "There are $count user records and $err errors\n"; print $fh "$key\t" . $ref->asc_encode . "\n"; ++$count; } else { - Log('DXCommand', "Export Error3: $key\t$val"); + LogDbg('DXCommand', "Export Error3: $key\t$val"); eval {$dbm->del($key)}; dbg(carp("Export Error3: $key\t$val\n$@")) if $@; ++$err; @@ -681,11 +686,6 @@ sub wantpc16 return _want('pc16', @_); } -sub wantpc90 -{ - return _wantnot('pc90', @_); -} - sub wantsendpc16 { return _want('sendpc16', @_); @@ -711,11 +711,6 @@ sub wantdxitu return _want('dxitu', @_); } -sub wantnp -{ - return _wantnot('np', @_); -} - sub wantlogininfo { my $self = shift;