use strict;
use vars qw($VERSION $BRANCH);
$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
use strict;
use vars qw($VERSION $BRANCH);
$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
priv => '9,Privilege Level',
lastin => '0,Last Time in,cldatetime',
passwd => '9,Password,yesno',
priv => '9,Privilege Level',
lastin => '0,Last Time in,cldatetime',
passwd => '9,Password,yesno',
addr => '0,Full Address',
'sort' => '0,Type of User', # A - ak1a, U - User, S - spider cluster, B - BBS
xpert => '0,Expert Status,yesno',
addr => '0,Full Address',
'sort' => '0,Type of User', # A - ak1a, U - User, S - spider cluster, B - BBS
xpert => '0,Expert Status,yesno',
hmsgno => '0,Highest Msgno',
group => '0,Access Group,parray', # used to create a group of users/nodes for some purpose or other
isolate => '9,Isolate network,yesno',
hmsgno => '0,Highest Msgno',
group => '0,Access Group,parray', # used to create a group of users/nodes for some purpose or other
isolate => '9,Isolate network,yesno',
- wantbeep => '0,Rec Beep,yesno',
- wantann => '0,Rec Announce,yesno',
- wantwwv => '0,Rec WWV,yesno',
- wantwcy => '0,Rec WCY,yesno',
- wantecho => '0,Rec Echo,yesno',
- wanttalk => '0,Rec Talk,yesno',
- wantwx => '0,Rec WX,yesno',
- wantdx => '0,Rec DX Spots,yesno',
- wantemail => '0,Rec Msgs as Email,yesno',
+ wantbeep => '0,Req Beep,yesno',
+ wantann => '0,Req Announce,yesno',
+ wantwwv => '0,Req WWV,yesno',
+ wantwcy => '0,Req WCY,yesno',
+ wantecho => '0,Req Echo,yesno',
+ wanttalk => '0,Req Talk,yesno',
+ wantwx => '0,Req WX,yesno',
+ wantdx => '0,Req DX Spots,yesno',
+ wantemail => '0,Req Msgs as Email,yesno',
pagelth => '0,Current Pagelth',
pingint => '9,Node Ping interval',
nopings => '9,Ping Obs Count',
wantlogininfo => '9,Login info req,yesno',
wantgrid => '0,DX Grid Info,yesno',
wantann_talk => '0,Talklike Anns,yesno',
pagelth => '0,Current Pagelth',
pingint => '9,Node Ping interval',
nopings => '9,Ping Obs Count',
wantlogininfo => '9,Login info req,yesno',
wantgrid => '0,DX Grid Info,yesno',
wantann_talk => '0,Talklike Anns,yesno',
+ 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',
lastoper => '9,Last for/oper,cldatetime',
nothere => '0,Not Here Text',
registered => '9,Registered?,yesno',
lastoper => '9,Last for/oper,cldatetime',
nothere => '0,Not Here Text',
registered => '9,Registered?,yesno',
- $dbm = tie (%u, 'DB_File', $fn, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!)";
+ $dbm = tie (%u, 'DB_File', $fn, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_asc?]";
- $dbm = tie (%u, 'DB_File', $fn, O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!)";
+ $dbm = tie (%u, 'DB_File', $fn, O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_asc?]";
- $dbm->put($call, $self->encode);
+ $lru->put($call, $self);
+ my $ref = $self->encode;
+ $dbm->put($call, $ref);
DXUser->del_file($main::userfn);
DXUser->init($main::userfn, 1);
DXUser->del_file($main::userfn);
DXUser->init($main::userfn, 1);
-
-%u = (
- };
-
- for ($action = R_FIRST; !$dbm->seq($key, $ref, $action); $action = R_NEXT) {
- print $fh "'$key' => q{$ref},\n";
- ++$count;
+%u = ();
+my $count = 0;
+my $err = 0;
+while (<DATA>) {
+ chomp;
+ my @f = split /\t/;
+ my $ref = decode($f[1]);
+ if ($ref) {
+ $ref->put();
+ $count++;
+ } else {
+ print "# Error: $f[0]\t$f[1]\n";
+ $err++
+ }
+}
+DXUser->sync; DXUser->finish;
+print "There are $count user records and $err errors\n";
+};
+ print $fh "__DATA__\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");
+ eval {$dbm->del($key)};
+ dbg(carp("Export Error1: $key\t$val\n$@")) if $@;
+ ++$err;
+ next;
+ }
+ my $ref = decode($val);
+ if ($ref) {
+ print $fh "$key\t" . $ref->encode . "\n";
+ ++$count;
+ } else {
+ Log('DXCommand', "Export Error2: $key\t$val");
+ eval {$dbm->del($key)};
+ dbg(carp("Export Error2: $key\t$val\n$@")) if $@;
+ ++$err;
+ }