X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=3df7fc20b218e42a2afb90da8fa03d0dec82cbf7;hb=da65011693cc9a7a33f09424f7a19a51937d986c;hp=f371161ba2a13feee8c4b96d07a3b948d4012060;hpb=db100bf2aacab3c8a6e09569b0f9a166dc4996c5;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index f371161b..3df7fc20 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', @@ -93,6 +93,7 @@ $v3 = 0; version => '1,Version', build => '1,Build', believe => '1,Believable nodes,parray', + lastping => '1,Last Ping at,ptimelist', ); #no strict; @@ -263,7 +264,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}; @@ -481,16 +482,20 @@ 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; + Log('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 $@; @@ -784,7 +789,7 @@ sub set_believe my $self = shift; my $call = uc shift; $self->{believe} ||= []; - push @{$self->{believe}}, $call; + push @{$self->{believe}}, $call unless grep $_ eq $call, @{$self->{believe}}; } sub unset_believe @@ -796,6 +801,23 @@ sub unset_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__