X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=6e2c014e80febe2efcd84be9afc6d08b9a67da3e;hb=ee822fc8bbe6985f708cca37ce3953b83651e542;hp=b254ae5ab1723b33b159058014af9a146295afb4;hpb=ab10b5e76b152d41273281b30b019e4c82ed22d8;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index b254ae5a..6e2c014e 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -75,7 +75,7 @@ $v3 = 0; pagelth => '0,Current Pagelth', pingint => '9,Node Ping interval', nopings => '9,Ping Obs Count', - wantlogininfo => '9,Login info req,yesno', + wantlogininfo => '0,Login Info Req,yesno', wantgrid => '0,Show DX Grid,yesno', wantann_talk => '0,Talklike Anns,yesno', wantpc90 => '1,Req PC90,yesno', @@ -92,6 +92,8 @@ $v3 = 0; prompt => '0,Required Prompt', version => '1,Version', build => '1,Build', + believe => '1,Believable nodes,parray', + lastping => '1,Last Ping at,ptimelist', ); #no strict; @@ -210,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; } @@ -262,7 +270,7 @@ sub get_current my $pkg = shift; my $call = uc shift; - my $dxchan = DXChannel->get($call); + my $dxchan = DXChannel::get($call); return $dxchan->user if $dxchan; my $rref = Route::get($call); return $rref->user if $rref && exists $rref->{user}; @@ -336,8 +344,7 @@ sub asc_decode my $ref; eval '$ref = ' . $s; if ($@) { - dbg($@); - Log('err', $@); + LogDbg('err', $@); $ref = undef; } return $ref; @@ -480,20 +487,24 @@ print "There are $count user records and $err errors\n"; for ($action = R_FIRST; !$dbm->seq($key, $val, $action); $action = R_NEXT) { if (!is_callsign($key) || $key =~ /^0/) { - Log('DXCommand', "Export Error1: $key\t$val"); + 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: $ekey\t$eval"); eval {$dbm->del($key)}; - dbg(carp("Export Error1: $key\t$val\n$@")) if $@; + dbg(carp("Export Error1: $ekey\t$eval\n$@")) if $@; ++$err; next; } my $ref = decode($val); if ($ref) { my $t = $ref->{lastin} || 0; - if ($main::systime > $t + $tooold) { + if ($ref->{sort} eq 'U' && !$ref->{priv} && $main::systime > $t + $tooold) { 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; } @@ -502,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; @@ -777,6 +788,41 @@ sub unset_passphrase my $self = shift; delete $self->{passphrase}; } + +sub set_believe +{ + my $self = shift; + my $call = uc shift; + $self->{believe} ||= []; + push @{$self->{believe}}, $call unless grep $_ eq $call, @{$self->{believe}}; +} + +sub unset_believe +{ + my $self = shift; + my $call = uc shift; + if (exists $self->{believe}) { + $self->{believe} = [grep {$_ ne $call} @{$self->{believe}}]; + delete $self->{believe} unless @{$self->{believe}}; + } +} + +sub believe +{ + my $self = shift; + return exists $self->{believe} ? @{$self->{believe}} : (); +} + +sub lastping +{ + my $self = shift; + my $call = shift; + $self->{lastping} ||= {}; + $self->{lastping} = {} unless ref $self->{lastping}; + my $b = $self->{lastping}; + $b->{$call} = shift if @_; + return $b->{$call}; +} 1; __END__