X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=34870a953dc91311ae9b10bc216b28b2e88113a8;hb=0560e85c7f60462fccb5b54d5ec2c0d88338001e;hp=840498c041d3e4d20c707e398c0b0a8028ef625a;hpb=ae313f260d904cd45b58e4d1e620a49aef1a42c9;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 840498c0..34870a95 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -3,7 +3,7 @@ # # Copyright (c) 1998 - Dirk Koopman G1TLH # -# $Id$ +# # package DXUser; @@ -19,12 +19,6 @@ 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; - use vars qw(%u $dbm $filename %valid $lastoperinterval $lasttime $lru $lrusize $tooold $v3); %u = (); @@ -86,6 +80,7 @@ $v3 = 0; wantdxcq => '0,Show CQ Zone,yesno', wantdxitu => '0,Show ITU Zone,yesno', wantgtk => '0,Want GTK interface,yesno', + wantpc9x => '0,Want PC9X interface,yesno', lastoper => '9,Last for/oper,cldatetime', nothere => '0,Not Here Text', registered => '9,Registered?,yesno', @@ -242,17 +237,25 @@ sub new sub get { - my $pkg = shift; my $call = uc shift; my $data; # is it in the LRU cache? my $ref = $lru->get($call); - return $ref if $ref; + return $ref if $ref && ref $ref eq 'DXUser'; # search for it unless ($dbm->get($call, $data)) { $ref = decode($data); + if ($ref) { + if (ref $ref ne 'DXUser') { + dbg("DXUser::get: got strange answer from decode ". ref $ref. " ignoring"); + return undef; + } + } else { + dbg("DXUser::get: no reference returned from decode $!"); + return undef; + } $lru->put($call, $ref); return $ref; } @@ -269,14 +272,16 @@ sub get sub get_current { - my $pkg = shift; my $call = uc shift; my $dxchan = DXChannel::get($call); - return $dxchan->user if $dxchan; - my $rref = Route::get($call); - return $rref->user if $rref && exists $rref->{user}; - return $pkg->get($call); + if ($dxchan) { + my $ref = $dxchan->user; + return $ref if ref $ref eq 'DXUser'; + + dbg("DXUser::get_current: got invalid user ref from dxchan $dxchan->{call} ". ref $ref. " ignoring"); + } + return get($call); } # @@ -722,6 +727,11 @@ sub wantgtk return _want('gtk', @_); } +sub wantpc9x +{ + return _want('pc9x', @_); +} + sub wantlogininfo { my $self = shift;