From: minima Date: Sun, 19 Jan 2003 01:08:18 +0000 (+0000) Subject: fix export_user so that it cleans out old users X-Git-Tag: PRE-1-52~87 X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=985ef8460d1cd74eee9576e6d32e625fdeb6a76c;p=spider.git fix export_user so that it cleans out old users --- diff --git a/Changes b/Changes index cdf50df9..f3f209d8 100644 --- a/Changes +++ b/Changes @@ -9,6 +9,8 @@ users, then you can do a set/routepc19 to enable PC19 propagation. In the even more rare case of you wanting to prevent PC19s being routed thru your node, you can use unset/routepc19. THIS IS NOT A SUBSTITUTE FOR ROUTE FILTERING!!!!! [translators: I have added wpc16s, wpc16u, wpc19s, wpc19u] +2. Alter the export_user command to remove users that have no useful info +and have not been seen for more than (default) 1 year. 17Jan03======================================================================= 1. Fix problem with lines being left in the main input queue for a disconnected/ing node. diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 66434a0e..9a6dabf3 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -916,7 +916,8 @@ sub normal } } else { $pc19list{$call} = [] unless exists $pc19list{$call}; - push @{$pc19list{$call}}, [$self->{call}, $ver, $flags]; + my $nl = $pc19list{$call}; + push @{$pc19list{$call}}, [$self->{call}, $ver, $flags] unless grep $_->[0] eq $self->{call}, @$nl; } } diff --git a/perl/DXUser.pm b/perl/DXUser.pm index e5a6a3b2..7c9a4b36 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -25,7 +25,7 @@ $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); +use vars qw(%u $dbm $filename %valid $lastoperinterval $lasttime $lru $lrusize $tooold); %u = (); $dbm = undef; @@ -33,6 +33,7 @@ $filename = undef; $lastoperinterval = 60*24*60*60; $lasttime = 0; $lrusize = 2000; +$tooold = 86400 * 365; # this marks an old user who hasn't given enough info to be useful # hash of valid elements and a simple prompt %valid = ( @@ -341,6 +342,7 @@ sub export my $count = 0; my $err = 0; + my $del = 0; my $fh = new IO::File ">$fn" or return "cannot open $fn ($!)"; if ($fh) { my $key = 0; @@ -422,18 +424,29 @@ print "There are $count user records and $err errors\n"; } my $ref = decode($val); if ($ref) { + my $t = $ref->{lastin} || 0; + if ($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"); + $del++; + next; + } + } + # only store users that are reasonably active or have useful information print $fh "$key\t" . $ref->encode . "\n"; ++$count; } else { - Log('DXCommand', "Export Error2: $key\t$val"); + Log('DXCommand', "Export Error3: $key\t$val"); eval {$dbm->del($key)}; - dbg(carp("Export Error2: $key\t$val\n$@")) if $@; + dbg(carp("Export Error3: $key\t$val\n$@")) if $@; ++$err; } } $fh->close; } - return "$count Users $err Errors ('sh/log Export' for details)"; + return "$count Users $del Deleted $err Errors ('sh/log Export' for details)"; } #