X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=e35031e67dd4dd752547ef79a86546328f5b18ad;hb=171a7a0bf86e9732a33c7829e808129ec01c51c2;hp=f825ebb87b772006f5eec0aa28c19aa5a30d3cdd;hpb=21e7642d216656c60b164d76208633a0c81cf5db;p=spider.git

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index f825ebb8..e35031e6 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
 }
 
 #
@@ -118,7 +119,7 @@ sub normal
 	  
 	  # format and broadcast it to users
 	  my $spotter = $field[6];
-	  $spotter =~ s/^(\w+)-\d+/$1/;    # strip off the ssid from the spotter
+	  $spotter =~ s/-\d+$//o;         # strip off the ssid from the spotter
       $spotter .= ':';                # add a colon
 	  
 	  # send orf to the users
@@ -134,10 +135,25 @@ sub normal
 
         # strip leading and trailing stuff
 	    my $text = unpad($field[3]);
-		my $target = "To Sysops" if $field[4] eq '*';
-		$target = "WX" if $field[6];
+		my $target;
+		my @list;
+		
+	    if ($field[4] eq '*') {          # sysops
+		  $target = "To Sysops";
+		  @list = map { $_->priv >= 5 ? $_ : () } get_all_users();
+		} elsif ($field[4] gt ' ') {     # speciality list handling
+		  my ($name) = split /\./, $field[4]; 
+          $target = "To $name";          # put the rest in later (if bothered) 
+        } 
+		
+        $target = "WX" if $field[6] eq '1';
 		$target = "To All" if !$target;
-		broadcast_users("$target de $field[1]: $text"); 
+		
+		if (@list > 0) {
+		  broadcast_list("$target de $field[1]: $text", @list);
+		} else {
+		  broadcast_users("$target de $field[1]: $text");
+		}
 		
 		return if $field[2] eq $main::mycall;   # it's routed to me
 	  } else {
@@ -157,15 +173,22 @@ 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;
-        $call =~ s/^(\w+)-\d+/$1/;        # remove ssid
+		$call = uc $call;
+        $call =~ s/-\d+$//o;        # remove ssid
 		next if DXCluster->get($call);    # we already have this (loop?)
 		
 		$confmode = $confmode eq '*';
 		DXNodeuser->new($self, $node, $call, $confmode, $here);
+		
+		# add this station to the user database, if required
+		my $user = DXUser->get_current($call);
+		$user = DXUser->new($call) if !$user;
+		$user->node($node->call) if !$user->node;
+		$user->put;
 	  }
 	  last SWITCH;
 	}
@@ -178,12 +201,7 @@ sub normal
 	
     if ($pcno == 18) {              # link request
 	
-      # send our nodes
-	  my $hops = get_hops(19);
-	  $self->send($me->pc19(get_all_ak1a()));
-	  
-      # get all the local users and send them out
-	  $self->send($me->pc16(get_all_users()));
+	  $self->send_local_config();
 	  $self->send(pc20());
 	  last SWITCH;
 	}
@@ -192,10 +210,10 @@ sub normal
       my $i;
 	  for ($i = 1; $i < $#field-1; $i += 4) {
 	    my $here = $field[$i];
-	    my $call = $field[$i+1];
+	    my $call = uc $field[$i+1];
 		my $confmode = $field[$i+2] eq '*';
 		my $ver = $field[$i+3];
-		
+
 		# now check the call over
 		next if DXCluster->get($call);   # we already have this
 		
@@ -208,26 +226,29 @@ sub normal
 	}
 	
     if ($pcno == 20) {              # send local configuration
-
-      # send our nodes
-	  my $hops = get_hops(19);
-	  $self->send($me->pc19(get_all_ak1a()));
-	  
-      # get all the local users and send them out
-	  $self->send($me->pc16(get_all_users()));
+	  $self->send_local_config();
 	  $self->send(pc22());
 	  return;
 	}
 	
     if ($pcno == 21) {             # delete a cluster from the list
-	  my $ref = DXCluster->get($field[1]);
+	  my $call = uc $field[1];
+	  my $ref = DXCluster->get($call);
 	  $ref->del() if $ref;
 	  last SWITCH;
 	}
 	
     if ($pcno == 22) {last SWITCH;}
     if ($pcno == 23) {last SWITCH;}
-    if ($pcno == 24) {last SWITCH;}
+
+    if ($pcno == 24) {             # set here status
+	  my $call = uc $field[1];
+	  $call =~ s/-\d+//o;
+	  my $ref = DXCluster->get($call);
+	  $ref->here($field[2]) if $ref;
+	  last SWITCH;
+	}
+	
     if ($pcno == 25) {last SWITCH;}
     if ($pcno == 26) {last SWITCH;}
     if ($pcno == 27) {last SWITCH;}
@@ -242,9 +263,36 @@ sub normal
     if ($pcno == 36) {last SWITCH;}
     if ($pcno == 37) {last SWITCH;}
     if ($pcno == 38) {last SWITCH;}
-    if ($pcno == 39) {last SWITCH;}
+
+    if ($pcno == 39) {              # incoming disconnect
+      $self->disconnect();
+	  return;
+	}
+	
     if ($pcno == 40) {last SWITCH;}
-    if ($pcno == 41) {last SWITCH;}
+    if ($pcno == 41) {              # user info
+      # add this station to the user database, if required
+	  my $user = DXUser->get_current($field[1]);
+	  $user = DXUser->new($field[1]) if !$user;
+	  
+	  if ($field[2] == 1) {
+	    $user->name($field[3]);
+	  } elsif ($field[2] == 2) {
+	    $user->qth($field[3]);
+	  } elsif ($field[2] == 3) {
+        my ($latd, $latm, $latl, $longd, $longm, $longl) = split /\s+/, $field[3];
+		$longd += ($longm/60);
+		$longd = 0-$longd if (uc $longl) eq 'W'; 
+		$user->long($longd);
+		$latd += ($latm/60);
+		$latd = 0-$latd if (uc $latl) eq 'S';
+		$user->lat($latd);
+	  } elsif ($field[2] == 4) {
+	    $user->node($field[3]);
+	  }
+	  $user->put;
+	  last SWITCH;
+	}
     if ($pcno == 42) {last SWITCH;}
     if ($pcno == 43) {last SWITCH;}
     if ($pcno == 44) {last SWITCH;}
@@ -283,11 +331,8 @@ sub normal
   #        REBROADCAST!!!!
   #
   
-  my $hopfield = pop @field;
-  push @field, $hopfield; 
-  
   my $hops;
-  if (($hops) = $hopfield =~ /H(\d+)\^\~?$/o) {
+  if (($hops) = $line =~ /H(\d+)\^\~?$/o) {
 	my $newhops = $hops - 1;
 	if ($newhops > 0) {
 	  $line =~ s/\^H$hops(\^\~?)$/\^H$newhops$1/;       # change the hop count
@@ -323,52 +368,44 @@ sub process
 sub finish
 {
   my $self = shift;
-  broadcast_ak1a($self->pc21('Gone.'));
-  $self->delnode();
-}
- 
-# 
-# add a (local) user to the cluster
-#
-
-sub adduser
-{
-  DXNodeuser->add(@_);
-}
+  my $ref = DXCluster->get($self->call);
+  
+  # broadcast to all other nodes that all the nodes connected to via me are gone
+  my @nodes = map { $_->dxchan == $self ? $_ : () } DXNode::get_all();
+  my $node;
 
-#
-# delete a (local) user to the cluster
-#
+  foreach $node (@nodes) {
+    next if $node->call eq $self->call; 
+    broadcast_ak1a(DXProt::pc21($node, 'Gone'), $self);    # done like this 'cos DXNodes don't have a pc21 method
+  }
 
-sub deluser
-{
-  my $self = shift;
-  my $ref = DXCluster->get($self->call);
+  # now broadcast to all other ak1a nodes that I have gone
+  broadcast_ak1a($self->pc21('Gone.'), $self);
   $ref->del() if $ref;
 }
 
 #
-# add a (locally connected) node to the cluster
+# some active measures
 #
 
-sub addnode
-{
-  DXNode->new(@_);
-}
-
-#
-# delete a (locally connected) node to the cluster
-#
-sub delnode
+sub send_local_config
 {
   my $self = shift;
-  my $ref = DXCluster->get($self->call);
-  $ref->del() if $ref;
-}
+  my $n;
 
-#
-# some active measures
-#
+  # send our nodes
+  my @nodes = DXNode::get_all();
+  
+  # create a list of all the nodes that are not connected to this connection
+  @nodes = map { $_->dxchan != $self ? $_ : () } @nodes;
+  $self->send($me->pc19(@nodes));
+	  
+  # get all the users connected on the above nodes and send them out
+  foreach $n (@nodes) {
+    my @users = values %{$n->list};
+    $self->send(DXProt::pc16($n, @users));
+  }
+}
 
 #
 # route a message down an appropriate interface for a callsign
@@ -380,8 +417,17 @@ sub route
   my ($call, $line) = @_;
   my $cl = DXCluster->get($call);
   if ($cl) {
-    my $dxchan = $cl->{dxchan};
-    $cl->send($line) if $dxchan;
+    my $hops;
+	my $dxchan = $cl->{dxchan};
+	if (($hops) = $line =~ /H(\d+)\^\~?$/o) {
+	  my $newhops = $hops - 1;
+	  if ($newhops > 0) {
+	    $line =~ s/\^H$hops(\^\~?)$/\^H$newhops$1/;       # change the hop count
+		$dxchan->send($line) if $dxchan;
+	  }
+	} else {
+ 	  $dxchan->send($line) if $dxchan;                    # for them wot don't have Hops
+	}
   }
 }
 
@@ -394,7 +440,8 @@ sub broadcast_ak1a
   my $chan;
   
   foreach $chan (@chan) {
-	 $chan->send($s) if !grep $chan, @except;              # send it if it isn't the except list
+     next if grep $chan == $_, @except;
+	 $chan->send($s);              # send it if it isn't the except list
   }
 }
 
@@ -407,7 +454,19 @@ sub broadcast_users
   my $chan;
   
   foreach $chan (@chan) {
-	 $chan->send($s) if !grep $chan, @except;              # send it if it isn't the except list
+    next if grep $chan == $_, @except;
+	$chan->send($s);              # send it if it isn't the except list
+  }
+}
+
+# broadcast to a list of users
+sub broadcast_list
+{
+  my $s = shift;
+  my $chan;
+  
+  foreach $chan (@_) {
+	$chan->send($s);              # send it 
   }
 }