use MLDBM qw(DB_File);
use Fcntl;
+use Carp;
+
+use strict;
+use vars qw(%u $dbm $filename %valid);
%u = undef;
$dbm = 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',
- lastin => 'Last Time in',
- passwd => 'Password',
- addr => 'Full Address',
- 'sort' => 'Type of User', # A - ak1a, U - User, S - spider cluster, B - BBS
+ 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,Last Node',
+ homenode => '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?
+ lang => '0,Language',
+ hmsgno => '0,Highest Msgno',
);
+no strict;
sub AUTOLOAD
{
my $self = shift;
return if $name =~ /::DESTROY$/;
$name =~ s/.*:://o;
- die "Non-existant field '$AUTOLOAD'" if !$valid{$name};
- @_ ? $self->{$name} = shift : $self->{$name} ;
+ confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
+ if (@_) {
+ $self->{$name} = shift;
+ $self->put();
+ }
+ return $self->{$name};
}
#
{
my ($pkg, $fn) = @_;
- 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 ($!)";
+ confess "need a filename in User" if !$fn;
+ $dbm = tie (%u, MLDBM, $fn, O_CREAT|O_RDWR, 0666) or confess "can't open user file: $fn ($!)";
$filename = $fn;
}
+use strict;
+
#
# close the system
#
sub new
{
- my ($pkg, $call) = @_;
- die "can't create existing call $call in User\n!" if $u{$call};
+ my $pkg = shift;
+ my $call = uc shift;
+# $call =~ s/-\d+$//o;
+
+ confess "can't create existing call $call in User\n!" if $u{$call};
my $self = {};
$self->{call} = $call;
+ $self->{sort} = 'U';
+ $self->{dxok} = 1;
+ $self->{annok} = 1;
+ $self->{lang} = $main::lang;
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 ($pkg, $call) = @_;
+ my $pkg = shift;
+ my $call = uc shift;
+# $call =~ s/-\d+$//o; # strip ssid
+ return $u{$call};
+}
+
+#
+# get all callsigns in the database
+#
+
+sub get_all_calls
+{
+ return (sort keys %u);
+}
+
+#
+# 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 = shift;
+ my $call = uc shift;
+# $call =~ s/-\d+$//o; # strip ssid
+
+ my $dxchan = DXChannel->get($call);
+ return $dxchan->user if $dxchan;
return $u{$call};
}