X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=bc55775fc6f3e277bcfcf40e140081bbdbc6bea5;hb=6a0068ec3df1dca0c6ae2714af3c0a4a62998dcf;hp=7ff5b2260d60ad7983ec0d859da1ea933323f958;hpb=21e7642d216656c60b164d76208633a0c81cf5db;p=spider.git

diff --git a/perl/DXUser.pm b/perl/DXUser.pm
index 7ff5b226..bc55775f 100644
--- a/perl/DXUser.pm
+++ b/perl/DXUser.pm
@@ -15,6 +15,9 @@ use MLDBM qw(DB_File);
 use Fcntl;
 use Carp;
 
+use strict;
+use vars qw(%u $dbm $filename %valid);
+
 %u = undef;
 $dbm = undef;
 $filename = undef;
@@ -40,9 +43,12 @@ $filename = undef;
   lockout => '9,Locked out?,yesno',        # won't let them in at all
   dxok => '9,DX Spots?,yesno',            # accept his dx spots?
   annok => '9,Announces?,yesno',            # accept his announces?
-  reg => '0,Registered?,yesno',            # is this user registered? 
+  reg => '0,Registered?,yesno',            # is this user registered?
+  lang => '0,Language',
+  hmsgno => '0,Highest Msgno',
 );
 
+no strict;
 sub AUTOLOAD
 {
   my $self = shift;
@@ -66,11 +72,13 @@ 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 ($!)";
+  confess "need a filename in User" if !$fn;
+  $dbm = tie (%u, MLDBM, $fn, O_CREAT|O_RDWR, 0666) or confess "can't open user file: $fn ($!)";
   $filename = $fn;
 }
 
+use strict;
+
 #
 # close the system
 #
@@ -87,8 +95,11 @@ sub finish
 
 sub new
 {
-  my ($pkg, $call) = @_;
-  die "can't create existing call $call in User\n!" if $u{$call};
+  my $pkg = shift;
+  my $call = uc shift;
+  $call =~ s/-\d+//o;
+  
+  confess "can't create existing call $call in User\n!" if $u{$call};
 
   my $self = {};
   $self->{call} = $call;
@@ -106,10 +117,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 (sort keys %u);
+}
+
 #
 # get an existing either from the channel (if there is one) or from the database
 #
@@ -120,7 +142,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};