From 0560e85c7f60462fccb5b54d5ec2c0d88338001e Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Sat, 10 May 2008 14:50:00 +0100 Subject: [PATCH] add more error messages around DXUser::get* --- perl/DXUser.pm | 19 ++++++++++++++----- perl/Version.pm | 2 +- 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/perl/DXUser.pm b/perl/DXUser.pm index e2c24f59..34870a95 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -242,14 +242,18 @@ sub get # 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); - 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"); + 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); @@ -271,7 +275,12 @@ sub get_current my $call = uc shift; my $dxchan = DXChannel::get($call); - return $dxchan->user if $dxchan; + 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); } diff --git a/perl/Version.pm b/perl/Version.pm index bb6d3449..b5ad051a 100644 --- a/perl/Version.pm +++ b/perl/Version.pm @@ -11,6 +11,6 @@ use vars qw($version $subversion $build); $version = '1.55'; $subversion = '0'; -$build = '4'; +$build = '5'; 1; -- 2.34.1