X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=6b1db816665c46f276cb5b3662b8918cc29db299;hb=65bf111b2d360cf15aa470020872d593f21e3740;hp=956957e8260f1218f8eebeacd677b76795f98ef4;hpb=bca5cd40374f12da5e0d46980e54bffc61fdc9c9;p=spider.git

diff --git a/perl/DXUser.pm b/perl/DXUser.pm
index 956957e8..6b1db816 100644
--- a/perl/DXUser.pm
+++ b/perl/DXUser.pm
@@ -15,14 +15,16 @@ use DXLog;
 use DB_File;
 use Data::Dumper;
 use Fcntl;
-use Carp;
+use IO::File;
+use DXDebug;
 
 use strict;
-use vars qw(%u $dbm $filename %valid);
+use vars qw(%u $dbm $filename %valid $lastoperinterval);
 
 %u = ();
 $dbm = undef;
 $filename = undef;
+$lastoperinterval = 30*24*60*60;
 
 # hash of valid elements and a simple prompt
 %valid = (
@@ -44,8 +46,8 @@ $filename = undef;
 		  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?
+		  dxok => '9,Accept DX Spots?,yesno', # accept his dx spots?
+		  annok => '9,Accept Announces?,yesno', # accept his announces?
 		  reg => '0,Registered?,yesno',	# is this user registered?
 		  lang => '0,Language',
 		  hmsgno => '0,Highest Msgno',
@@ -54,12 +56,17 @@ $filename = undef;
 		  wantbeep => '0,Rec Beep,yesno',
 		  wantann => '0,Rec Announce,yesno',
 		  wantwwv => '0,Rec WWV,yesno',
+		  wantwcy => '0,Rec WCY,yesno',
+		  wantecho => '0,Rec Echo,yesno',
 		  wanttalk => '0,Rec Talk,yesno',
 		  wantwx => '0,Rec WX,yesno',
 		  wantdx => '0,Rec DX Spots,yesno',
+		  pagelth => '0,Current Pagelth',
 		  pingint => '9,Node Ping interval',
 		  nopings => '9,Ping Obs Count',
 		  wantlogininfo => '9,Login info req,yesno',
+	          wantgrid => '0,DX Grid Info,yesno',
+		  lastoper => '9,Last for/oper,cldatetime',
 		 );
 
 no strict;
@@ -123,9 +130,6 @@ sub new
 	my $self = bless {}, $pkg;
 	$self->{call} = $call;
 	$self->{'sort'} = 'U';
-	$self->{dxok} = 1;
-	$self->{annok} = 1;
-	$self->{lang} = $main::lang;
 	$self->put;
 	return $self;
 }
@@ -169,8 +173,7 @@ sub get_current
   
 	my $dxchan = DXChannel->get($call);
 	return $dxchan->user if $dxchan;
-	my $s = $u{$call};
-	return $s ? decode($s) : undef;
+	return get($pkg, $call);
 }
 
 #
@@ -182,7 +185,14 @@ sub put
 	my $self = shift;
 	confess "Trying to put nothing!" unless $self && ref $self;
 	my $call = $self->{call};
+	# delete all instances of this 
+	for ($dbm->get_dup($call)) {
+		$dbm->del_dup($call, $_);
+	}
+	delete $self->{annok} if $self->{annok};
+	delete $self->{dxok} if $self->{dxok};
 	$u{$call} = $self->encode();
+	$dbm->sync;
 }
 
 # 
@@ -220,7 +230,11 @@ sub del
 {
 	my $self = shift;
 	my $call = $self->{call};
-	delete $u{$call};
+	# delete all instances of this 
+	for ($dbm->get_dup($call)) {
+		$dbm->del_dup($call, $_);
+	}
+	$dbm->sync;
 }
 
 #
@@ -243,6 +257,52 @@ sub fields
 	return keys(%valid);
 }
 
+
+#
+# export the database to an ascii file
+#
+
+sub export
+{
+	my $fn = shift;
+	
+	# save old ones
+        rename "$fn.oooo", "$fn.ooooo" if -e "$fn.oooo";
+        rename "$fn.ooo", "$fn.oooo" if -e "$fn.ooo";
+        rename "$fn.oo", "$fn.ooo" if -e "$fn.oo";
+        rename "$fn.o", "$fn.oo" if -e "$fn.o";
+        rename "$fn", "$fn.o" if -e "$fn";
+
+	my $count = 0;
+	my $fh = new IO::File ">$fn" or return "cannot open $fn ($!)";
+	if ($fh) {
+		my $ref;
+		my $key;
+		my $action;
+		my $t = scalar localtime;
+		print $fh "#!/usr/bin/perl
+#
+# The exported userfile for a DXSpider System
+#
+# Input file: $filename
+#       Time: $t
+#
+
+package DXUser;
+
+%u = (
+";
+
+		for ($action = R_FIRST; !$dbm->seq($key, $ref, $action); $action = R_NEXT) {
+			print $fh "'$key' => $ref,\n";
+			++$count;
+		} 
+		print $fh ");\n#\n# there were $count records\n#\n";
+		$fh->close;
+	} 
+	return $count;
+}
+
 #
 # group handling
 #
@@ -326,9 +386,10 @@ sub _want
 {
 	my $n = shift;
 	my $self = shift;
+	my $val = shift;
 	my $s = "want$n";
-	return $self->{$n} = shift if @_;
-	return defined $self->{$n} ? $self->{$n} : 1;
+	$self->{$s} = $val if defined $val;
+	return exists $self->{$s} ? $self->{$s} : 1;
 }
 
 sub wantbeep
@@ -346,6 +407,16 @@ sub wantwwv
 	return _want('wwv', @_);
 }
 
+sub wantwcy
+{
+	return _want('wcy', @_);
+}
+
+sub wantecho
+{
+	return _want('echo', @_);
+}
+
 sub wantwx
 {
 	return _want('wx', @_);
@@ -361,10 +432,70 @@ sub wanttalk
 	return _want('talk', @_);
 }
 
+sub wantgrid
+{
+	return _want('grid', @_);
+}
+
 sub wantlogininfo
 {
-	return _want('logininfo', @_);
+	my $self = shift;
+	my $n = shift;
+	$self->{wantlogininfo} = $n if $n;
+	return exists $self->{wantlogininfo} ? $self->{wantlogininfo} : 0;
+}
+
+sub is_node
+{
+	my $self = shift;
+	return $self->{sort} =~ /[ACRSX]/;
+}
+
+sub is_user
+{
+	my $self = shift;
+	return $self->{sort} eq 'U';
+}
+
+sub is_bbs
+{
+	my $self = shift;
+	return $self->{sort} eq 'B';
+}
+
+sub is_spider
+{
+	my $self = shift;
+	return $self->{sort} eq 'S';
+}
+
+sub is_clx
+{
+	my $self = shift;
+	return $self->{sort} eq 'C';
+}
+
+sub is_dxnet
+{
+	my $self = shift;
+	return $self->{sort} eq 'X';
+}
+
+sub is_arcluster
+{
+	my $self = shift;
+	return $self->{sort} eq 'R';
 }
 
+sub is_ak1a
+{
+	my $self = shift;
+	return $self->{sort} eq 'A';
+}
 1;
 __END__
+
+
+
+
+