X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=0ef376f0409fa4809897392149d2cadecbc36dc1;hb=cce161221036760959ff1d0b7628a55942bf558a;hp=9d636561115edcd7d61f69eec3898b0689c96cd9;hpb=84505457c5b3757715d97a63acd792b28fc1841a;p=spider.git

diff --git a/perl/DXUser.pm b/perl/DXUser.pm
index 9d636561..0ef376f0 100644
--- a/perl/DXUser.pm
+++ b/perl/DXUser.pm
@@ -18,7 +18,7 @@ use Carp;
 use strict;
 use vars qw(%u $dbm $filename %valid);
 
-%u = undef;
+%u = ();
 $dbm = undef;
 $filename = undef;
 
@@ -36,15 +36,19 @@ $filename = undef;
   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
+  '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,Home Node',
+  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',
+  group => '0,Access Group,parray',               # used to create a group of users/nodes for some purpose or other
+  isolate => '9,Isolate network,yesno',
 );
 
 no strict;
@@ -71,8 +75,8 @@ sub init
 {
   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;
 }
 
@@ -94,14 +98,18 @@ sub finish
 
 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->{'sort'} = 'U';
   $self->{dxok} = 1;
   $self->{annok} = 1;
+  $self->{lang} = $main::lang;
   bless $self, $pkg;
   $u{call} = $self;
 }
@@ -115,7 +123,7 @@ sub get
 {
   my $pkg = shift;
   my $call = uc shift;
-  $call =~ s/-\d+//o;       # strip ssid
+#  $call =~ s/-\d+$//o;       # strip ssid
   return $u{$call};
 }
 
@@ -140,7 +148,7 @@ sub get_current
 {
   my $pkg = shift;
   my $call = uc shift;
-  $call =~ s/-\d+//o;       # strip ssid
+#  $call =~ s/-\d+$//o;       # strip ssid
   
   my $dxchan = DXChannel->get($call);
   return $dxchan->user if $dxchan;
@@ -189,6 +197,67 @@ sub fields
   return keys(%valid);
 }
 
+#
+# group handling
+#
+
+# add one or more groups
+sub add_group
+{
+	my $self = shift;
+	my $ref = $self->{group} || [ 'local' ];
+	$self->{group} = $ref if !$self->{group};
+	push @$ref, @_ if @_;
+}
+
+# remove one or more groups
+sub del_group
+{
+	my $self = shift;
+	my $ref = $self->{group} || [ 'local' ];
+	my @in = @_;
+	
+	$self->{group} = $ref if !$self->{group};
+	
+	@$ref = map { my $a = $_; return (grep { $_ eq $a } @in) ? () : $a } @$ref;
+}
+
+# does this thing contain all the groups listed?
+sub union
+{
+	my $self = shift;
+	my $ref = $self->{group};
+	my $n;
+	
+	return 0 if !$ref || @_ == 0;
+	return 1 if @$ref == 0 && @_ == 0;
+	for ($n = 0; $n < @_; ) {
+		for (@$ref) {
+			my $a = $_;
+			$n++ if grep $_ eq $a, @_; 
+		}
+	}
+	return $n >= @_;
+}
+
+# simplified group test just for one group
+sub in_group
+{
+	my $self = shift;
+	my $s = shift;
+	my $ref = $self->{group};
+	
+	return 0 if !$ref;
+	return grep $_ eq $s, $ref;
+}
+
+# set up a default group (only happens for them's that connect direct)
+sub new_group
+{
+	my $self = shift;
+	$self->{group} = [ 'local' ];
+}
+
 #
 # return a prompt for a field
 #
@@ -199,45 +268,11 @@ sub field_prompt
   return $valid{$ele};
 }
 
-#
-# enter an element from input, returns 1 for success
-#
-
-sub enter
-{
-  my ($self, $ele, $value) = @_;
-  return 0 if (!defined $valid{$ele});
-  chomp $value;
-  return 0 if $value eq "";
-  if ($ele eq 'long') {
-    my ($longd, $longm, $longl) = $value =~ /(\d+) (\d+) ([EWew])/;
-	return 0 if (!$longl || $longd < 0 || $longd > 180 || $longm < 0 || $longm > 59);
-	$longd += ($longm/60);
-	$longd = 0-$longd if (uc $longl) eq 'W'; 
-	$self->{'long'} = $longd;
-	return 1;
-  } elsif ($ele eq 'lat') {
-    my ($latd, $latm, $latl) = $value =~ /(\d+) (\d+) ([NSns])/;
-	return 0 if (!$latl || $latd < 0 || $latd > 90 || $latm < 0 || $latm > 59);
-	$latd += ($latm/60);
-	$latd = 0-$latd if (uc $latl) eq 'S';
-	$self->{'lat'} = $latd;
-	return 1;
-  } elsif ($ele eq 'qra') {
-    $self->{'qra'} = UC $value;
-	return 1;
-  } else {
-    $self->{$ele} = $value;               # default action
-	return 1;
-  }
-  return 0;
-}
-
 # some variable accessors
 sub sort
 {
   my $self = shift;
-  @_ ? $self->{sort} = shift : $self->{sort} ;
+  @_ ? $self->{'sort'} = shift : $self->{'sort'} ;
 }
 1;
 __END__