From 41879a3e698b56d4505b2b45c54480b0258f8289 Mon Sep 17 00:00:00 2001 From: minima Date: Tue, 1 Nov 2005 20:18:14 +0000 Subject: [PATCH] fix a little used logging error for export. --- perl/DXUser.pm | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/perl/DXUser.pm b/perl/DXUser.pm index cd30264e..3df7fc20 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -20,8 +20,10 @@ use LRU; use strict; use vars qw($VERSION $BRANCH); - -main::mkver($VERSION = q$Revision$); +$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); +$main::build += $VERSION; +$main::branch += $BRANCH; use vars qw(%u $dbm $filename %valid $lastoperinterval $lasttime $lru $lrusize $tooold $v3); @@ -297,7 +299,6 @@ sub put $lru->put($call, $self); my $ref = $self->encode; $dbm->put($call, $ref); - return $self; } # freeze the 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 $@; @@ -725,12 +730,6 @@ sub is_node return $self->{sort} =~ /[ACRSX]/; } -sub is_aranea -{ - my $self = shift; - return $self->{sort} eq 'W'; -} - sub is_user { my $self = shift; -- 2.34.1