2 # DX cluster user routines
4 # Copyright (c) 1998 - Dirk Koopman G1TLH
14 use MLDBM qw(DB_File);
21 # hash of valid elements and a simple prompt
24 alias => '0,Real Callsign',
27 lat => '0,Latitude,slat',
28 long => '0,Longitude,slong',
30 email => '0,E-mail Address',
31 priv => '9,Privilege Level',
32 lastin => '0,Last Time in,cldatetime',
33 passwd => '9,Password',
34 addr => '0,Full Address',
35 sort => '0,Type of User', # A - ak1a, U - User, S - spider cluster, B - BBS
36 wwv => '0,Want WWV,yesno',
37 talk => '0,Want Talk,yesno',
38 ann => '0,Want Announce,yesno',
39 here => '0,Here Status,yesno',
40 xpert => '0,Expert Status,yesno',
42 node => '0,Home Node',
43 dx => '0,DX Spots,yesno',
51 return if $name =~ /::DESTROY$/;
54 die "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;
100 # get - get an existing user
105 my ($pkg, $call) = @_;
116 my $call = $self->{call};
121 # del - delete a user
127 my $call = $self->{call};
132 # close - close down a user
138 $self->{lastin} = time;
143 # return a list of valid elements
152 # return a prompt for a field
157 my ($self, $ele) = @_;
162 # enter an element from input, returns 1 for success
167 my ($self, $ele, $value) = @_;
168 return 0 if (!defined $valid{$ele});
170 return 0 if $value eq "";
171 if ($ele eq 'long') {
172 my ($longd, $longm, $longl) = $value =~ /(\d+) (\d+) ([EWew])/;
173 return 0 if (!$longl || $longd < 0 || $longd > 180 || $longm < 0 || $longm > 59);
174 $longd += ($longm/60);
175 $longd = 0-$longd if (uc $longl) eq 'W';
176 $self->{'long'} = $longd;
178 } elsif ($ele eq 'lat') {
179 my ($latd, $latm, $latl) = $value =~ /(\d+) (\d+) ([NSns])/;
180 return 0 if (!$latl || $latd < 0 || $latd > 90 || $latm < 0 || $latm > 59);
182 $latd = 0-$latd if (uc $latl) eq 'S';
183 $self->{'lat'} = $latd;
185 } elsif ($ele eq 'qra') {
186 $self->{'qra'} = UC $value;
189 $self->{$ele} = $value; # default action
195 # some variable accessors
199 @_ ? $self->{sort} = shift : $self->{sort} ;