From: djk <djk>
Date: Sun, 20 Sep 1998 11:52:42 +0000 (+0000)
Subject: did some work on the cluster database related things
X-Git-Tag: SPIDER_1_5~40
X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=7432cb12ce865030c8b0315a30764e0088a59102;p=spider.git

did some work on the cluster database related things
---

diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 519a0b48..7d835171 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -32,10 +32,11 @@ use DXDebug;
 use Carp;
 
 use strict;
+use vars qw(%channels %valid);
 
-my %channels = undef;
+%channels = undef;
 
-my %valid = (
+%valid = (
   call => '0,Callsign',
   conn => '9,Msg Conn ref',
   user => '9,DXUser ref',
@@ -55,6 +56,7 @@ my %valid = (
   here => '0,Here?,yesno',
   confmode => '0,In Conference?,yesno',
   dx => '0,DX Spots,yesno',
+  redirect => '0,Redirect messages to',
 );
 
 # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm
index 9560ba57..2ddd2358 100644
--- a/perl/DXCluster.pm
+++ b/perl/DXCluster.pm
@@ -20,10 +20,11 @@ use Carp;
 use DXDebug;
 
 use strict;
+use vars qw(%cluster %valid);
 
-my %cluster = ();            # this is where we store the dxcluster database
+%cluster = ();            # this is where we store the dxcluster database
 
-my %valid = (
+%valid = (
   mynode => '0,Parent Node,showcall',
   call => '0,Callsign',
   confmode => '0,Conference Mode,yesno',
@@ -61,13 +62,6 @@ sub get_all
   return values(%cluster);
 }
 
-sub delcluster;
-{
-  my $self = shift;
-  delete $cluster{$self->{call}};
-}
-
-
 # return a prompt for a field
 sub field_prompt
 { 
@@ -138,9 +132,9 @@ sub new
   
   my $self = $pkg->alloc($dxchan, $call, $confmode, $here);
   $self->{mynode} = $node;
-  $self->{list}->{$call} = $self;     # add this user to the list on this node
+  $node->{list}->{$call} = $self;     # add this user to the list on this node
   $users++;
-  dbg('cluster', "allocating user $self->{call}\n");
+  dbg('cluster', "allocating user $call to $node->{call} in cluster\n");
   return $self;
 }
 
@@ -151,7 +145,8 @@ sub del
   my $node = $self->{mynode};
  
   delete $node->{list}->{$call};
-  delete $cluster{$call};     # remove me from the cluster table
+  delete $DXCluster::cluster{$call};     # remove me from the cluster table
+  dbg('cluster', "deleting user $call from $node->{call} in cluster\n");
   $users-- if $users > 0;
 }
 
@@ -182,7 +177,7 @@ sub new
   $self->{version} = $pcversion;
   $self->{list} = { } ;
   $nodes++;
-  dbg('cluster', "allocating node $self->{call}\n");
+  dbg('cluster', "allocating node $call to cluster\n");
   return $self;
 }
 
@@ -191,7 +186,7 @@ sub get_all
 {
   my $list;
   my @out;
-  foreach $list (values(%cluster)) {
+  foreach $list (values(%DXCluster::cluster)) {
     push @out, $list if $list->{pcversion};
   }
   return @out;
@@ -207,6 +202,7 @@ sub del
   foreach $ref (values %{$self->{list}}) {
     $ref->del();      # this also takes them out of this list
   }
+  dbg('cluster', "deleting node $call from cluster\n"); 
   $nodes-- if $nodes > 0;
 }
 
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 9f7b3885..d39af559 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -59,7 +59,16 @@ sub start
   # set some necessary flags on the user if they are connecting
   $self->{wwv} = $self->{talk} = $self->{ann} = $self->{here} = $self->{dx} = 1;
   $self->prompt() if $self->{state} =~ /^prompt/o;
-
+  
+  # add yourself to the database
+  my $node = DXNode->get($main::mycall) or die "$main::mycall not allocated in DXNode database";
+  my $cuser = DXNodeuser->new($self, $node, $call, 0, 1);
+  $node->dxchan($self) if $call eq $main::myalias;       # send all output for mycall to myalias
+  
+  # issue a pc16 to everybody interested
+  my $nchan = DXChannel->get($main::mycall);
+  my $pc16 = $nchan->pc16($cuser);
+  DXProt::broadcast_ak1a($pc16);
 }
 
 #
@@ -133,7 +142,21 @@ sub process
 #
 sub finish
 {
+  my $self = shift;
+  my $call = $self->call;
 
+  if ($call eq $main::myalias) {   # unset the channel if it is us really
+    my $node = DXNode->get($main::mycall);
+	$node->{dxchan} = 0;
+  }
+  my $ref = DXNodeuser->get($call);
+
+  # issue a pc17 to everybody interested
+  my $nchan = DXChannel->get($main::mycall);
+  my $pc17 = $nchan->pc17($ref);
+  DXProt::broadcast_ak1a($pc17);
+  
+  $ref->del() if $ref;
 }
 
 #
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index f825ebb8..d75dd46c 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -23,14 +23,15 @@ use Date::Parse;
 use DXProtout;
 
 use strict;
+use vars qw($me);
 
-my $me;            # the channel id for this cluster
+$me = undef;            # the channel id for this cluster
 
 sub init
 {
   my $user = DXUser->get($main::mycall);
-  $me = DXChannel::alloc('DXProt', $main::mycall, undef, $user); 
-  $me->{sort} = 'M';    # M for me
+  $me = DXProt->new($main::mycall, undef, $user); 
+#  $me->{sort} = 'M';    # M for me
 }
 
 #
@@ -157,7 +158,7 @@ sub normal
 	  last SWITCH if !$node;        # ignore if havn't seen a PC19 for this one yet
 	  my $i;
 	  
-	  for ($i = 2; $i < $#field-1; $i++) {
+	  for ($i = 2; $i < $#field; $i++) {
 	    my ($call, $confmode, $here) = $field[$i] =~ /^(\w+) (-) (\d)/o;
 		next if length $call < 3;
 		next if !$confmode;
@@ -324,44 +325,6 @@ sub finish
 {
   my $self = shift;
   broadcast_ak1a($self->pc21('Gone.'));
-  $self->delnode();
-}
- 
-# 
-# add a (local) user to the cluster
-#
-
-sub adduser
-{
-  DXNodeuser->add(@_);
-}
-
-#
-# delete a (local) user to the cluster
-#
-
-sub deluser
-{
-  my $self = shift;
-  my $ref = DXCluster->get($self->call);
-  $ref->del() if $ref;
-}
-
-#
-# add a (locally connected) node to the cluster
-#
-
-sub addnode
-{
-  DXNode->new(@_);
-}
-
-#
-# delete a (locally connected) node to the cluster
-#
-sub delnode
-{
-  my $self = shift;
   my $ref = DXCluster->get($self->call);
   $ref->del() if $ref;
 }
diff --git a/perl/Prefix.pm b/perl/Prefix.pm
index b9e235cd..5f23fce9 100644
--- a/perl/Prefix.pm
+++ b/perl/Prefix.pm
@@ -145,9 +145,9 @@ sub extract
   # remove any /0-9 /P /A /M /MM /AM suffixes etc
   if (@parts > 1) {
     $p = $parts[$#parts];
-	pop @parts if $p =~ /^\d+|[PABM]|AM|MM|BCN|SIX$/o;
+	pop @parts if $p =~ /^(\d+|[PABM]|AM|MM|BCN|SIX)$/o;
     $p = $parts[$#parts];
-	pop @parts if $p =~ /^\d+|[PABM]|AM|MM|BCN|SIX$/o;
+	pop @parts if $p =~ /^(\d+|[PABM]|AM|MM|BCN|SIX)$/o;
   
     # can we resolve them by direct lookup
 	foreach $p (@parts) {
diff --git a/perl/Spot.pm b/perl/Spot.pm
index 64af363e..08520c5b 100644
--- a/perl/Spot.pm
+++ b/perl/Spot.pm
@@ -18,12 +18,13 @@ use Carp;
 @ISA = qw(Julian);
 
 use strict;
+use vars qw($fp $maxspots $defaultspots $maxdays $dirprefix);
 
-my $fp;
-my $maxspots = 50;      # maximum spots to return
-my $defaultspots = 10;    # normal number of spots to return
-my $maxdays = 35;        # normal maximum no of days to go back
-my $dirprefix = "$main::data/spots";
+$fp = undef;
+$maxspots = 50;      # maximum spots to return
+$defaultspots = 10;    # normal number of spots to return
+$maxdays = 35;        # normal maximum no of days to go back
+$dirprefix = "$main::data/spots";
 
 sub prefix
 {
diff --git a/perl/cluster.pl b/perl/cluster.pl
index e98dd156..e3309a15 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -185,6 +185,9 @@ $SIG{'HUP'} = 'IGNORE';
 # initialise the protocol engine
 DXProt->init();
 
+# put in a DXCluster node for us here so we can add users and take them away
+DXNode->new(0, $mycall, 0, 1, $DXProtvars::myprot_version); 
+
 # this, such as it is, is the main loop!
 print "orft we jolly well go ...\n";
 for (;;) {
diff --git a/perl/dxcc.pl b/perl/dxcc.pl
index 3b4d97f0..889b62e9 100755
--- a/perl/dxcc.pl
+++ b/perl/dxcc.pl
@@ -1,6 +1,7 @@
 #!/usr/bin/perl
 #
-# convert an Ak1a DX.DAT file to comma delimited form
+# Analyse the dxcc info in the prefix database, listing the 'official' country and its number
+# and also looking for duplicates and missing numbers
 #
 #
 
@@ -15,8 +16,16 @@ sub comp
   return ($a->dxcc()-0) <=> ($b->dxcc()-0);
 }
 
+$lastdxcc = 0;
 foreach $ref (sort {$a->dxcc() <=> $b->dxcc()} values %Prefix::prefix_loc) {
   $name = $ref->name();
   $dxcc = $ref->dxcc();
-  print "dxcc: $dxcc name: $name\n";
+  while ($lastdxcc < $dxcc - 1) {
+	++$lastdxcc;
+    print "dxcc: $lastdxcc name:  ** MISSING\n";
+  }
+  $dup = "";
+  $dup = "** DUPLICATE" if $dxcc == $lastdxcc;
+  print "dxcc: $dxcc name: $name $dup\n";
+  $lastdxcc = $dxcc;
 }