X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=adddce0a4cef1f5701536e8d361530cc303f6244;hb=9335fc83d6c885d49ac336e7058a5d5657da97cd;hp=056fe9ff50b3a1e2ce1c42cccc6f3491b4f19839;hpb=c3c15883cf25add24fc49e32eb0d17dce6839a62;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 056fe9ff..adddce0a 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); @@ -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; } @@ -480,16 +488,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 $@; @@ -724,12 +736,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;