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 => 'Real Callsign',
30 email => 'E-mail Address',
31 priv => 'Privilege Level',
32 sort => 'Type of User',
33 lastin => 'Last Time in',
35 addr => 'Full Address'
39 # initialise the system
45 die "need a filename in User" if !$fn;
46 $dbm = tie %u, MLDBM, $fn, O_CREAT|O_RDWR, 0666 or die "can't open user file: $fn ($!)";
61 # new - create a new user
66 my ($pkg, $call) = @_;
67 die "can't create existing call $call in User\n!" if $u{$call};
70 $self->{call} = $call;
76 # get - get an existing user
81 my ($pkg, $call) = @_;
92 my $call = $self->{call};
103 my $call = $self->{call};
108 # close - close down a user
114 $self->{lastin} = time;
119 # return a list of valid elements
128 # return a prompt together with the existing value
133 my ($self, $ele) = @_;
134 return "$valid{$ele} [$self->{$ele}]";
138 # enter an element from input, returns 1 for success
143 my ($self, $ele, $value) = @_;
144 return 0 if (!defined $valid{$ele});
146 return 0 if $value eq "";
147 if ($ele eq 'long') {
148 my ($longd, $longm, $longl) = $value =~ /(\d+) (\d+) ([EWew])/;
149 return 0 if (!$longl || $longd < 0 || $longd > 180 || $longm < 0 || $longm > 59);
150 $longd += ($longm/60);
151 $longd = 0-$longd if (uc $longl) eq 'W';
152 $self->{'long'} = $longd;
154 } elsif ($ele eq 'lat') {
155 my ($latd, $latm, $latl) = $value =~ /(\d+) (\d+) ([NSns])/;
156 return 0 if (!$latl || $latd < 0 || $latd > 90 || $latm < 0 || $latm > 59);
158 $latd = 0-$latd if (uc $latl) eq 'S';
159 $self->{'lat'} = $latd;
161 } elsif ($ele eq 'qra') {
162 $self->{'qra'} = UC $value;
165 $self->{$ele} = $value; # default action