added announce

[spider.git] / perl / DXUser.pm

diff --git a/perl/DXUser.pm b/perl/DXUser.pm
index cdbc0b23c81c542ea3dd79b698ba8bf7b79ec074..08c5824a7f4f1b8508ff263c0452eaf25d92a5ce 100644 (file)
--- a/perl/DXUser.pm
+++ b/perl/DXUser.pm
@@ -13,6 +13,10 @@ require Exporter;
 
 use MLDBM qw(DB_File);
 use Fcntl;
+use Carp;
+
+use strict;
+use vars qw(%u $dbm $filename %valid);
 
 %u = undef;
 $dbm = undef;
@@ -42,6 +46,7 @@ $filename = undef;
   reg => '0,Registered?,yesno',            # is this user registered? 
 );
 
+no strict;
 sub AUTOLOAD
 {
   my $self = shift;
@@ -50,7 +55,7 @@ sub AUTOLOAD
   return if $name =~ /::DESTROY$/;
   $name =~ s/.*:://o;
   
-  die "Non-existant field '$AUTOLOAD'" if !$valid{$name};
+  confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
   if (@_) {
     $self->{$name} = shift;
        $self->put();
@@ -66,10 +71,12 @@ sub init
   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;
 }
 
+use strict;
+
 #
 # close the system
 #
@@ -105,10 +112,21 @@ sub new
 
 sub get
 {
-  my ($pkg, $call) = @_;
+  my $pkg = shift;
+  my $call = uc shift;
+  $call =~ s/-\d+//o;       # strip ssid
   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
 #
@@ -119,7 +137,10 @@ sub get
 
 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};