projects
/
spider.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
added announce
[spider.git]
/
perl
/
DXUser.pm
diff --git
a/perl/DXUser.pm
b/perl/DXUser.pm
index 7ff5b2260d60ad7983ec0d859da1ea933323f958..08c5824a7f4f1b8508ff263c0452eaf25d92a5ce 100644
(file)
--- a/
perl/DXUser.pm
+++ b/
perl/DXUser.pm
@@
-15,6
+15,9
@@
use MLDBM qw(DB_File);
use Fcntl;
use Carp;
use Fcntl;
use Carp;
+use strict;
+use vars qw(%u $dbm $filename %valid);
+
%u = undef;
$dbm = undef;
$filename = undef;
%u = undef;
$dbm = undef;
$filename = undef;
@@
-43,6
+46,7
@@
$filename = undef;
reg => '0,Registered?,yesno', # is this user registered?
);
reg => '0,Registered?,yesno', # is this user registered?
);
+no strict;
sub AUTOLOAD
{
my $self = shift;
sub AUTOLOAD
{
my $self = shift;
@@
-67,10
+71,12
@@
sub init
my ($pkg, $fn) = @_;
die "need a filename in User" if !$fn;
my ($pkg, $fn) = @_;
die "need a filename in User" if !$fn;
- $dbm = tie
%u, MLDBM, $fn, O_CREAT|O_RDWR, 0666
or die "can't open user file: $fn ($!)";
+ $dbm = tie
(%u, MLDBM, $fn, O_CREAT|O_RDWR, 0666)
or die "can't open user file: $fn ($!)";
$filename = $fn;
}
$filename = $fn;
}
+use strict;
+
#
# close the system
#
#
# close the system
#
@@
-106,10
+112,21
@@
sub new
sub get
{
sub get
{
- my ($pkg, $call) = @_;
+ my $pkg = shift;
+ my $call = uc shift;
+ $call =~ s/-\d+//o; # strip ssid
return $u{$call};
}
return $u{$call};
}
+#
+# get all callsigns in the database
+#
+
+sub get_all_calls
+{
+ return keys %u;
+}
+
#
# get an existing either from the channel (if there is one) or from the database
#
#
# get an existing either from the channel (if there is one) or from the database
#
@@
-120,7
+137,10
@@
sub get
sub get_current
{
sub get_current
{
- my ($pkg, $call) = @_;
+ my $pkg = shift;
+ my $call = uc shift;
+ $call =~ s/-\d+//o; # strip ssid
+
my $dxchan = DXChannel->get($call);
return $dxchan->user if $dxchan;
return $u{$call};
my $dxchan = DXChannel->get($call);
return $dxchan->user if $dxchan;
return $u{$call};