projects
/
spider.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
commit again
[spider.git]
/
perl
/
DXUser.pm
diff --git
a/perl/DXUser.pm
b/perl/DXUser.pm
index ad1b890cb7e7bbf34cabb150a3dffcd2fa51fc5a..eaf880392c26e880198220c5fd7437ec53d3ea47 100644
(file)
--- a/
perl/DXUser.pm
+++ b/
perl/DXUser.pm
@@
-8,9
+8,6
@@
package DXUser;
package DXUser;
-require Exporter;
-@ISA = qw(Exporter);
-
use DXLog;
use DB_File;
use Data::Dumper;
use DXLog;
use DB_File;
use Data::Dumper;
@@
-104,6
+101,15
@@
sub init
$filename = $fn;
}
$filename = $fn;
}
+sub del_file
+{
+ my ($pkg, $fn, $mode) = @_;
+
+ confess "need a filename in User" if !$fn;
+ $fn .= ".v2";
+ unlink $fn;
+}
+
use strict;
#
use strict;
#
@@
-155,18
+161,11
@@
sub get
{
my $pkg = shift;
my $call = uc shift;
{
my $pkg = shift;
my $call = uc shift;
- # $call =~ s/-\d+$//o; # strip ssid
- my $s = $u{$call};
- return $s ? decode($s) : undef;
-}
-
-#
-# get all callsigns in the database
-#
-
-sub get_all_calls
-{
- return (sort keys %u);
+ my $data;
+ unless ($dbm->get($call, $data)) {
+ return decode($data);
+ }
+ return undef;
}
#
}
#
@@
-181,11
+180,23
@@
sub get_current
{
my $pkg = shift;
my $call = uc shift;
{
my $pkg = shift;
my $call = uc shift;
- # $call =~ s/-\d+$//o; # strip ssid
my $dxchan = DXChannel->get($call);
return $dxchan->user if $dxchan;
my $dxchan = DXChannel->get($call);
return $dxchan->user if $dxchan;
- return get($pkg, $call);
+ my $data;
+ unless ($dbm->get($call, $data)) {
+ return decode($data);
+ }
+ return undef;
+}
+
+#
+# get all callsigns in the database
+#
+
+sub get_all_calls
+{
+ return (sort keys %u);
}
#
}
#
@@
-203,7
+214,7
@@
sub put
}
delete $self->{annok} if $self->{annok};
delete $self->{dxok} if $self->{dxok};
}
delete $self->{annok} if $self->{annok};
delete $self->{dxok} if $self->{dxok};
- $
u{$call} = $self->encode(
);
+ $
dbm->put($call, $self->encode
);
}
#
}
#
@@
-226,10
+237,12
@@
sub decode
{
my $s = shift;
my $ref;
{
my $s = shift;
my $ref;
- $s = '$ref = ' . $s;
- eval $s;
- Log('DXUser', $@) if $@;
- $ref = undef if $@;
+ eval '$ref = ' . $s;
+ if ($@) {
+ dbg('err', $@) if $@;
+ Log('err', $@) if $@;
+ $ref = undef;
+ }
return $ref;
}
return $ref;
}