X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=f2273a7a4d24dd95454d4b69421b75bd781c297f;hb=171a7a0bf86e9732a33c7829e808129ec01c51c2;hp=7ff5b2260d60ad7983ec0d859da1ea933323f958;hpb=21e7642d216656c60b164d76208633a0c81cf5db;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 7ff5b226..f2273a7a 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,11 @@ $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', ); +no strict; sub AUTOLOAD { my $self = shift; @@ -67,10 +72,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 # @@ -106,10 +113,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 # @@ -120,7 +138,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};