X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=e2c24f598a5eee6d7fdd941ade20ac7f46cb0c78;hb=ab811a0c902225075a9bd69749f65594079433a9;hp=413d56a6446c6678b779498498ef4bfd56146ef9;hpb=679037f49e292b15a73dce96699c15b9e3049711;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 413d56a6..e2c24f59 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,7 +237,6 @@ sub new sub get { - my $pkg = shift; my $call = uc shift; my $data; @@ -252,6 +247,11 @@ sub get # search for it unless ($dbm->get($call, $data)) { $ref = decode($data); + dbg("DXUser::get: data error on $call $!") unless $ref; + if ($ref && ref $ref ne 'DXUser') { + dbg("DXUser::get: got strange answer from decode ". ref $ref. " ignoring"); + return undef; + } $lru->put($call, $ref); return $ref; } @@ -268,14 +268,11 @@ 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); + return get($call); } # @@ -329,11 +326,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); } # @@ -343,6 +336,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', $@); @@ -719,6 +713,16 @@ sub wantdxitu return _want('dxitu', @_); } +sub wantgtk +{ + return _want('gtk', @_); +} + +sub wantpc9x +{ + return _want('pc9x', @_); +} + sub wantlogininfo { my $self = shift;