X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=cdbc0b23c81c542ea3dd79b698ba8bf7b79ec074;hb=1cf4bd14be226274d5deb05da8480ab91a5dac52;hp=60abaeda3098f77598b67e2603f33790c3661c75;hpb=60c0ea1747bc8ad95e531d29025f7bcee4fd10c1;p=spider.git

diff --git a/perl/DXUser.pm b/perl/DXUser.pm
index 60abaeda..cdbc0b23 100644
--- a/perl/DXUser.pm
+++ b/perl/DXUser.pm
@@ -20,21 +20,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;
+  
+  die "Non-existant field '$AUTOLOAD'" if !$valid{$name};
+  if (@_) {
+    $self->{$name} = shift;
+	$self->put();
+  }
+  return $self->{$name};
+}
+
 #
 # initialise the system
 #
@@ -42,8 +65,8 @@ sub init
 {
   my ($pkg, $fn) = @_;
   
-  die "need a filename in User\n" if !$fn;
-  $dbm = tie %u, MLDBM, $fn, O_CREAT|O_RDWR, 0666 or die "can't open user file: $fn ($!)\n";
+  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 ($!)";
   $filename = $fn;
 }
 
@@ -68,17 +91,37 @@ 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
 {
-  my $call = shift;
+  my ($pkg, $call) = @_;
+  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};
 }
 
@@ -119,19 +162,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 +210,12 @@ sub enter
   }
   return 0;
 }
+
+# some variable accessors
+sub sort
+{
+  my $self = shift;
+  @_ ? $self->{sort} = shift : $self->{sort} ;
+}
 1;
 __END__