X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=0af77f04df235d0da9e136dc5e7df3eb4f8856fa;hb=e00a697bdb9f7c066b3e921d4f8ccc9bb9cf7485;hp=7ff5b2260d60ad7983ec0d859da1ea933323f958;hpb=21e7642d216656c60b164d76208633a0c81cf5db;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 7ff5b226..0af77f04 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; @@ -36,13 +39,17 @@ $filename = undef; sort => '0,Type of User', # A - ak1a, U - User, S - spider cluster, B - BBS xpert => '0,Expert Status,yesno', bbs => '0,Home BBS', - node => '0,Home Node', + node => '0,Last Node', + homenode => '0,Home Node', 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 +73,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,14 +96,18 @@ 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; $self->{sort} = 'U'; $self->{dxok} = 1; $self->{annok} = 1; + $self->{lang} = $main::lang; bless $self, $pkg; $u{call} = $self; } @@ -106,10 +119,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 +144,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};