X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=perl%2FDXUser.pm;h=7ff5b2260d60ad7983ec0d859da1ea933323f958;hb=21e7642d216656c60b164d76208633a0c81cf5db;hp=b593a6b2ad7f22eb33982e275a1aed51923259fd;hpb=07ea293f3919d2da76220b5fbc55b734008ed44c;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index b593a6b2..7ff5b226 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -13,6 +13,7 @@ require Exporter; use MLDBM qw(DB_File); use Fcntl; +use Carp; %u = undef; $dbm = undef; @@ -32,15 +33,14 @@ $filename = undef; lastin => '0,Last Time in,cldatetime', passwd => '9,Password', addr => '0,Full Address', - sort => '0,Type of User', # A - ak1a, U - User, S - spider cluster, B - BBS - wwv => '0,Want WWV,yesno', - talk => '0,Want Talk,yesno', - ann => '0,Want Announce,yesno', - here => '0,Here Status,yesno', + 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', - dx => '0,DX Spots,yesno', + 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? ); sub AUTOLOAD @@ -51,7 +51,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(); @@ -92,12 +92,16 @@ sub new my $self = {}; $self->{call} = $call; + $self->{sort} = 'U'; + $self->{dxok} = 1; + $self->{annok} = 1; bless $self, $pkg; $u{call} = $self; } # -# get - get an existing user +# get - get an existing user - this seems to return a different reference everytime it is +# called - see below # sub get @@ -106,6 +110,22 @@ sub get return $u{$call}; } +# +# get an existing either from the channel (if there is one) or from the database +# +# It is important to note that if you have done a get (for the channel say) and you +# want access or modify that you must use this call (and you must NOT use get's all +# over the place willy nilly!) +# + +sub get_current +{ + my ($pkg, $call) = @_; + my $dxchan = DXChannel->get($call); + return $dxchan->user if $dxchan; + return $u{$call}; +} + # # put - put a user #