2 # DX cluster user routines
4 # Copyright (c) 1998 - Dirk Koopman G1TLH
14 use MLDBM qw(DB_File);
19 use vars qw(%u $dbm $filename %valid);
25 # hash of valid elements and a simple prompt
28 alias => '0,Real Callsign',
31 lat => '0,Latitude,slat',
32 long => '0,Longitude,slong',
34 email => '0,E-mail Address',
35 priv => '9,Privilege Level',
36 lastin => '0,Last Time in,cldatetime',
37 passwd => '9,Password',
38 addr => '0,Full Address',
39 sort => '0,Type of User', # A - ak1a, U - User, S - spider cluster, B - BBS
40 xpert => '0,Expert Status,yesno',
42 node => '0,Home Node',
43 lockout => '9,Locked out?,yesno', # won't let them in at all
44 dxok => '9,DX Spots?,yesno', # accept his dx spots?
45 annok => '9,Announces?,yesno', # accept his announces?
46 reg => '0,Registered?,yesno', # is this user registered?
55 return if $name =~ /::DESTROY$/;
58 confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
60 $self->{$name} = shift;
63 return $self->{$name};
67 # initialise the system
73 die "need a filename in User" if !$fn;
74 $dbm = tie (%u, MLDBM, $fn, O_CREAT|O_RDWR, 0666) or die "can't open user file: $fn ($!)";
91 # new - create a new user
96 my ($pkg, $call) = @_;
97 die "can't create existing call $call in User\n!" if $u{$call};
100 $self->{call} = $call;
109 # get - get an existing user - this seems to return a different reference everytime it is
117 $call =~ s/-\d+//o; # strip ssid
122 # get all callsigns in the database
131 # get an existing either from the channel (if there is one) or from the database
133 # It is important to note that if you have done a get (for the channel say) and you
134 # want access or modify that you must use this call (and you must NOT use get's all
135 # over the place willy nilly!)
142 $call =~ s/-\d+//o; # strip ssid
144 my $dxchan = DXChannel->get($call);
145 return $dxchan->user if $dxchan;
156 my $call = $self->{call};
161 # del - delete a user
167 my $call = $self->{call};
172 # close - close down a user
178 $self->{lastin} = time;
183 # return a list of valid elements
192 # return a prompt for a field
197 my ($self, $ele) = @_;
202 # enter an element from input, returns 1 for success
207 my ($self, $ele, $value) = @_;
208 return 0 if (!defined $valid{$ele});
210 return 0 if $value eq "";
211 if ($ele eq 'long') {
212 my ($longd, $longm, $longl) = $value =~ /(\d+) (\d+) ([EWew])/;
213 return 0 if (!$longl || $longd < 0 || $longd > 180 || $longm < 0 || $longm > 59);
214 $longd += ($longm/60);
215 $longd = 0-$longd if (uc $longl) eq 'W';
216 $self->{'long'} = $longd;
218 } elsif ($ele eq 'lat') {
219 my ($latd, $latm, $latl) = $value =~ /(\d+) (\d+) ([NSns])/;
220 return 0 if (!$latl || $latd < 0 || $latd > 90 || $latm < 0 || $latm > 59);
222 $latd = 0-$latd if (uc $latl) eq 'S';
223 $self->{'lat'} = $latd;
225 } elsif ($ele eq 'qra') {
226 $self->{'qra'} = UC $value;
229 $self->{$ele} = $value; # default action
235 # some variable accessors
239 @_ ? $self->{sort} = shift : $self->{sort} ;