X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=cd30264e1d16e54cfaea2d45e57680b2de51e277;hb=3196486ff0a78459e1b88b3847d255a62fd17895;hp=e62123bfc1ef1a8235bb3c942b93f501db367f38;hpb=defc60f3e7fab9bb99d1c9f7b8bccc4ec37628d5;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index e62123bf..cd30264e 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -20,10 +20,8 @@ use LRU; use strict; use vars qw($VERSION $BRANCH); -$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; + +main::mkver($VERSION = q$Revision$); use vars qw(%u $dbm $filename %valid $lastoperinterval $lasttime $lru $lrusize $tooold $v3); @@ -75,7 +73,7 @@ $v3 = 0; pagelth => '0,Current Pagelth', pingint => '9,Node Ping interval', nopings => '9,Ping Obs Count', - wantlogininfo => '9,Login info req,yesno', + wantlogininfo => '0,Login Info Req,yesno', wantgrid => '0,Show DX Grid,yesno', wantann_talk => '0,Talklike Anns,yesno', wantpc90 => '1,Req PC90,yesno', @@ -92,6 +90,8 @@ $v3 = 0; prompt => '0,Required Prompt', version => '1,Version', build => '1,Build', + believe => '1,Believable nodes,parray', + lastping => '1,Last Ping at,ptimelist', ); #no strict; @@ -262,7 +262,7 @@ sub get_current my $pkg = shift; my $call = uc shift; - my $dxchan = DXChannel->get($call); + my $dxchan = DXChannel::get($call); return $dxchan->user if $dxchan; my $rref = Route::get($call); return $rref->user if $rref && exists $rref->{user}; @@ -297,6 +297,7 @@ sub put $lru->put($call, $self); my $ref = $self->encode; $dbm->put($call, $ref); + return $self; } # freeze the user @@ -592,6 +593,8 @@ sub sort } # some accessors + +# want is default = 1 sub _want { my $n = shift; @@ -602,6 +605,17 @@ sub _want return exists $self->{$s} ? $self->{$s} : 1; } +# wantnot is default = 0 +sub _wantnot +{ + my $n = shift; + my $self = shift; + my $val = shift; + my $s = "want$n"; + $self->{$s} = $val if defined $val; + return exists $self->{$s} ? $self->{$s} : 0; +} + sub wantbeep { return _want('beep', @_); @@ -662,6 +676,11 @@ sub wantpc16 return _want('pc16', @_); } +sub wantpc90 +{ + return _wantnot('pc90', @_); +} + sub wantsendpc16 { return _want('sendpc16', @_); @@ -687,6 +706,11 @@ sub wantdxitu return _want('dxitu', @_); } +sub wantnp +{ + return _wantnot('np', @_); +} + sub wantlogininfo { my $self = shift; @@ -701,6 +725,12 @@ sub is_node return $self->{sort} =~ /[ACRSX]/; } +sub is_aranea +{ + my $self = shift; + return $self->{sort} eq 'W'; +} + sub is_user { my $self = shift; @@ -754,6 +784,41 @@ sub unset_passphrase my $self = shift; delete $self->{passphrase}; } + +sub set_believe +{ + my $self = shift; + my $call = uc shift; + $self->{believe} ||= []; + push @{$self->{believe}}, $call unless grep $_ eq $call, @{$self->{believe}}; +} + +sub unset_believe +{ + my $self = shift; + my $call = uc shift; + if (exists $self->{believe}) { + $self->{believe} = [grep {$_ ne $call} @{$self->{believe}}]; + delete $self->{believe} unless @{$self->{believe}}; + } +} + +sub believe +{ + my $self = shift; + return exists $self->{believe} ? @{$self->{believe}} : (); +} + +sub lastping +{ + my $self = shift; + my $call = shift; + $self->{lastping} ||= {}; + $self->{lastping} = {} unless ref $self->{lastping}; + my $b = $self->{lastping}; + $b->{$call} = shift if @_; + return $b->{$call}; +} 1; __END__