$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;
$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 = (
wantpc90 => '1,Req PC90,yesno',
wantnp => '1,Req New Protocol,yesno',
wantpc16 => '9,Want Users from node,yesno',
- wantsendpc16 => '9,Send users to node,yesno',
+ wantsendpc16 => '9,Send PC16,yesno',
+ wantroutepc19 => '9,Route PC19,yesno',
lastoper => '9,Last for/oper,cldatetime',
nothere => '0,Not Here Text',
registered => '9,Registered?,yesno',
#no strict;
sub AUTOLOAD
{
- my $self = shift;
no strict;
my $name = $AUTOLOAD;
# this clever line of code creates a subroutine which takes over from autoload
# from OO Perl - Conway
*$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
- &$AUTOLOAD($self, @_);
-# *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
-# if (@_) {
-# $self->{$name} = shift;
-# }
-# return $self->{$name};
+ goto &$AUTOLOAD;
}
#use strict;
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;
}
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)";
}
#
return _want('sendpc16', @_);
}
+sub wantroutepc16
+{
+ return _want('routepc16', @_);
+}
+
sub wantlogininfo
{
my $self = shift;