X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=6e2c014e80febe2efcd84be9afc6d08b9a67da3e;hb=ee822fc8bbe6985f708cca37ce3953b83651e542;hp=62f262907fc6fa0ba6a48750766d95632e555b8f;hpb=d949d84b4220e77fac6b74f6a68051132737b260;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 62f26290..6e2c014e 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -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; } @@ -264,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}; @@ -338,8 +344,7 @@ sub asc_decode my $ref; eval '$ref = ' . $s; if ($@) { - dbg($@); - Log('err', $@); + LogDbg('err', $@); $ref = undef; } return $ref; @@ -482,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; } @@ -504,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;