X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=34870a953dc91311ae9b10bc216b28b2e88113a8;hb=0560e85c7f60462fccb5b54d5ec2c0d88338001e;hp=bca3b1dab70c7ea8ed7b2d1b01dbd6c75728d7d5;hpb=0791dd94e297b6c14167f4252b91f06e84fbcf6f;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index bca3b1da..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 = (); @@ -85,6 +79,8 @@ $v3 = 0; wantusstate => '0,Show US State,yesno', 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', @@ -241,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; } @@ -268,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); } # @@ -716,6 +722,16 @@ sub wantdxitu return _want('dxitu', @_); } +sub wantgtk +{ + return _want('gtk', @_); +} + +sub wantpc9x +{ + return _want('pc9x', @_); +} + sub wantlogininfo { my $self = shift;