2 # DX cluster user routines
4 # Copyright (c) 1998 - Dirk Koopman G1TLH
14 use MLDBM qw(DB_File);
22 # hash of valid elements and a simple prompt
25 alias => '0,Real Callsign',
28 lat => '0,Latitude,slat',
29 long => '0,Longitude,slong',
31 email => '0,E-mail Address',
32 priv => '9,Privilege Level',
33 lastin => '0,Last Time in,cldatetime',
34 passwd => '9,Password',
35 addr => '0,Full Address',
36 sort => '0,Type of User', # A - ak1a, U - User, S - spider cluster, B - BBS
37 xpert => '0,Expert Status,yesno',
39 node => '0,Home Node',
40 lockout => '9,Locked out?,yesno', # won't let them in at all
41 dxok => '9,DX Spots?,yesno', # accept his dx spots?
42 annok => '9,Announces?,yesno', # accept his announces?
43 reg => '0,Registered?,yesno', # is this user registered?
51 return if $name =~ /::DESTROY$/;
54 confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
56 $self->{$name} = shift;
59 return $self->{$name};
63 # initialise the system
69 die "need a filename in User" if !$fn;
70 $dbm = tie %u, MLDBM, $fn, O_CREAT|O_RDWR, 0666 or die "can't open user file: $fn ($!)";
85 # new - create a new user
90 my ($pkg, $call) = @_;
91 die "can't create existing call $call in User\n!" if $u{$call};
94 $self->{call} = $call;
103 # get - get an existing user - this seems to return a different reference everytime it is
109 my ($pkg, $call) = @_;
114 # get an existing either from the channel (if there is one) or from the database
116 # It is important to note that if you have done a get (for the channel say) and you
117 # want access or modify that you must use this call (and you must NOT use get's all
118 # over the place willy nilly!)
123 my ($pkg, $call) = @_;
124 my $dxchan = DXChannel->get($call);
125 return $dxchan->user if $dxchan;
136 my $call = $self->{call};
141 # del - delete a user
147 my $call = $self->{call};
152 # close - close down a user
158 $self->{lastin} = time;
163 # return a list of valid elements
172 # return a prompt for a field
177 my ($self, $ele) = @_;
182 # enter an element from input, returns 1 for success
187 my ($self, $ele, $value) = @_;
188 return 0 if (!defined $valid{$ele});
190 return 0 if $value eq "";
191 if ($ele eq 'long') {
192 my ($longd, $longm, $longl) = $value =~ /(\d+) (\d+) ([EWew])/;
193 return 0 if (!$longl || $longd < 0 || $longd > 180 || $longm < 0 || $longm > 59);
194 $longd += ($longm/60);
195 $longd = 0-$longd if (uc $longl) eq 'W';
196 $self->{'long'} = $longd;
198 } elsif ($ele eq 'lat') {
199 my ($latd, $latm, $latl) = $value =~ /(\d+) (\d+) ([NSns])/;
200 return 0 if (!$latl || $latd < 0 || $latd > 90 || $latm < 0 || $latm > 59);
202 $latd = 0-$latd if (uc $latl) eq 'S';
203 $self->{'lat'} = $latd;
205 } elsif ($ele eq 'qra') {
206 $self->{'qra'} = UC $value;
209 $self->{$ele} = $value; # default action
215 # some variable accessors
219 @_ ? $self->{sort} = shift : $self->{sort} ;