X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=840498c041d3e4d20c707e398c0b0a8028ef625a;hb=24550808f9ee4ba5cf6a720bb364977f7ed586af;hp=6e2c014e80febe2efcd84be9afc6d08b9a67da3e;hpb=ee822fc8bbe6985f708cca37ce3953b83651e542;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 6e2c014e..840498c0 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -61,7 +61,8 @@ $v3 = 0; annok => '9,Accept Announces?,yesno', # accept his announces? lang => '0,Language', hmsgno => '0,Highest Msgno', - group => '0,Chat Group,parray', # used to create a group of users/nodes for some purpose or other + group => '0,Group,parray', # used to create a group of users/nodes for some purpose or other + buddies => '0,Buddies,parray', isolate => '9,Isolate network,yesno', wantbeep => '0,Req Beep,yesno', wantann => '0,Req Announce,yesno', @@ -78,14 +79,13 @@ $v3 = 0; wantlogininfo => '0,Login Info Req,yesno', wantgrid => '0,Show DX Grid,yesno', wantann_talk => '0,Talklike Anns,yesno', - wantpc90 => '1,Req PC90,yesno', - wantnp => '1,Req New Proto,yesno', wantpc16 => '9,Want Users from node,yesno', wantsendpc16 => '9,Send PC16,yesno', wantroutepc19 => '9,Route PC19,yesno', wantusstate => '0,Show US State,yesno', wantdxcq => '0,Show CQ Zone,yesno', wantdxitu => '0,Show ITU Zone,yesno', + wantgtk => '0,Want GTK interface,yesno', lastoper => '9,Last for/oper,cldatetime', nothere => '0,Not Here Text', registered => '9,Registered?,yesno', @@ -143,7 +143,7 @@ sub init $ufn = "$fn.v3"; $v3 = 1; - $convert++ unless -e $ufn; + $convert++ if -e "$fn.v2" && !-e $ufn; } if ($mode) { @@ -152,10 +152,12 @@ sub init $dbm = tie (%u, 'DB_File', $ufn, O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_asc?]"; } + die "Cannot open $ufn ($!)\n" unless $dbm; + $lru = LRU->newbase("DXUser", $lrusize); # do a conversion if required - if ($convert) { + if ($dbm && $convert) { my ($key, $val, $action, $count, $err) = ('','',0,0,0); my %oldu; @@ -328,11 +330,7 @@ sub decode sub asc_encode { my $self = shift; - my $dd = new Data::Dumper([$self]); - $dd->Indent(0); - $dd->Terse(1); - $dd->Quotekeys($] < 5.005 ? 1 : 0); - return $dd->Dumpxs; + return dd($self); } # @@ -342,6 +340,7 @@ sub asc_decode { my $s = shift; my $ref; + $s =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg; eval '$ref = ' . $s; if ($@) { LogDbg('err', $@); @@ -585,6 +584,13 @@ sub new_group $self->{group} = [ 'local' ]; } +# set up empty buddies (only happens for them's that connect direct) +sub new_buddies +{ + my $self = shift; + $self->{buddies} = [ ]; +} + # # return a prompt for a field # @@ -686,11 +692,6 @@ sub wantpc16 return _want('pc16', @_); } -sub wantpc90 -{ - return _wantnot('pc90', @_); -} - sub wantsendpc16 { return _want('sendpc16', @_); @@ -716,9 +717,9 @@ sub wantdxitu return _want('dxitu', @_); } -sub wantnp +sub wantgtk { - return _wantnot('np', @_); + return _want('gtk', @_); } sub wantlogininfo @@ -735,6 +736,12 @@ sub is_node return $self->{sort} =~ /[ACRSX]/; } +sub is_local_node +{ + my $self = shift; + return grep $_ eq 'local_node', @{$self->{group}}; +} + sub is_user { my $self = shift;