X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=7ff5b2260d60ad7983ec0d859da1ea933323f958;hb=21e7642d216656c60b164d76208633a0c81cf5db;hp=7ce853c665513dc53a02315e42c59884de589c74;hpb=f77b59f4fcceb428142461972e94345419cbda28;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 7ce853c6..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; @@ -20,21 +21,44 @@ $filename = undef; # hash of valid elements and a simple prompt %valid = ( - call => 'Callsign', - alias => 'Real Callsign', - name => 'Name', - qth => 'Home QTH', - lat => 'Latitude', - long => 'Longtitude', - qra => 'Locator', - email => 'E-mail Address', - priv => 'Privilege Level', - sort => 'Type of User', - lastin => 'Last Time in', - passwd => 'Password', - addr => 'Full Address' + call => '0,Callsign', + alias => '0,Real Callsign', + name => '0,Name', + qth => '0,Home QTH', + lat => '0,Latitude,slat', + long => '0,Longitude,slong', + qra => '0,Locator', + email => '0,E-mail Address', + priv => '9,Privilege Level', + 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 + xpert => '0,Expert Status,yesno', + bbs => '0,Home BBS', + node => '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? ); +sub AUTOLOAD +{ + my $self = shift; + my $name = $AUTOLOAD; + + return if $name =~ /::DESTROY$/; + $name =~ s/.*:://o; + + confess "Non-existant field '$AUTOLOAD'" if !$valid{$name}; + if (@_) { + $self->{$name} = shift; + $self->put(); + } + return $self->{$name}; +} + # # initialise the system # @@ -68,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 @@ -82,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 # @@ -119,19 +163,19 @@ sub close # return a list of valid elements # -sub elements +sub fields { return keys(%valid); } # -# return a prompt together with the existing value +# return a prompt for a field # -sub prompt +sub field_prompt { my ($self, $ele) = @_; - return "$valid{$ele} [$self->{$ele}]"; + return $valid{$ele}; } # @@ -167,5 +211,12 @@ sub enter } return 0; } + +# some variable accessors +sub sort +{ + my $self = shift; + @_ ? $self->{sort} = shift : $self->{sort} ; +} 1; __END__