From 412fb1b9e4070d7791f4e986b55bbc0c06f612ea Mon Sep 17 00:00:00 2001
From: minima <minima>
Date: Mon, 3 Sep 2001 13:04:01 +0000
Subject: [PATCH] 6. make set/isolate and acc/route mutually exclusive (and
 issue appropriate error messages). 7. Improve stat/route_node and
 stat/route_user for diagnostics.

---
 Changes                |  4 ++++
 cmd/accept/route.pl    |  2 +-
 cmd/set/isolate.pl     | 13 +++++++++----
 cmd/stat/route_node.pl | 17 +++++++++++++++--
 cmd/stat/route_user.pl | 17 +++++++++++++++--
 perl/DXChannel.pm      |  1 +
 perl/DXCommandmode.pm  |  2 ++
 perl/DXProt.pm         |  5 +++--
 perl/DXUtil.pm         |  6 ++++--
 perl/Filter.pm         |  4 +++-
 perl/Messages          |  3 +++
 perl/Route/Node.pm     |  4 ++--
 perl/Route/User.pm     | 13 +++++++++++--
 perl/console.pl        |  2 +-
 14 files changed, 74 insertions(+), 19 deletions(-)

diff --git a/Changes b/Changes
index bf1412d6..a8fca892 100644
--- a/Changes
+++ b/Changes
@@ -6,6 +6,10 @@ more than one node.
 4. Make PC50s come out in one heap on all channels every 14 mins, instead of
 on the 14th minute in the connection time for each channel. This should 
 reduce (slightly) the dups that are dumped.
+5. Speed up input queue processing (a lot).
+6. make set/isolate and acc/route mutually exclusive (and issue appropriate
+error messages).
+7. Improve stat/route_node and stat/route_user for diagnostics.
 01Sep01=======================================================================
 1. Change build number calc (hopefully for the last time)
 27Aug01=======================================================================
diff --git a/cmd/accept/route.pl b/cmd/accept/route.pl
index 3b706a73..ab5f4e1c 100644
--- a/cmd/accept/route.pl
+++ b/cmd/accept/route.pl
@@ -11,4 +11,4 @@ my $type = 'accept';
 my $sort  = 'route';
 
 my ($r, $filter, $fno) = $Route::filterdef->cmd($self, $sort, $type, $line);
-return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 
+return (1, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); 
diff --git a/cmd/set/isolate.pl b/cmd/set/isolate.pl
index 9513a65e..89d8257b 100644
--- a/cmd/set/isolate.pl
+++ b/cmd/set/isolate.pl
@@ -26,11 +26,16 @@ foreach $call (@args) {
 		$user = DXUser->get($call);
 		$create = !$user;
 		$user = DXUser->new($call) if $create;
+		my $f;
+		push(@out, $self->msg('isoari', $call)), $f++ if Filter::getfn('route', $call, 1);
+		push(@out, $self->msg('isoaro', $call)), $f++ if Filter::getfn('route', $call, 0);
 		if ($user) {
-			$user->isolate(1);
-			$user->close();
-			push @out, $self->msg($create ? 'isoc' : 'iso', $call);
-			Log('DXCommand', $self->msg($create ? 'isoc' : 'iso', $call));
+			unless ($f) {
+				$user->isolate(1);
+				$user->close();
+				push @out, $self->msg($create ? 'isoc' : 'iso', $call);
+				Log('DXCommand', $self->msg($create ? 'isoc' : 'iso', $call));
+			}
 		} else {
 			push @out, $self->msg('e3', "Set/Isolate", $call);
 		}
diff --git a/cmd/stat/route_node.pl b/cmd/stat/route_node.pl
index 1cedcb44..c546e601 100644
--- a/cmd/stat/route_node.pl
+++ b/cmd/stat/route_node.pl
@@ -7,18 +7,31 @@
 #
 
 my ($self, $line) = @_;
+my @out;
 my @list = split /\s+/, $line;		      # generate a list of callsigns
 @list = ($self->call) if !@list;  # my channel if no callsigns
+if ($self->priv > 5 && @list && uc $list[0] eq 'ALL') {
+	push @out, "Node Callsigns in Routing Table";
+	@list = sort map {$_->call} Route::Node::get_all();
+	my $count = @list;
+	my $n = int $self->width / 10;
+	$n ||= 8;
+	while (@list > $n) {
+		push @out, join(' ', map {sprintf "%9s",$_ } splice(@list, 0, $n));
+	} 
+	push @out, join(' ', map {sprintf "%9s",$_ } @list) if @list;
+	push @out, "$count Nodes";
+	return (1, @out);
+}
 
 my $call;
-my @out;
 foreach $call (@list) {
   $call = uc $call;
   my $ref = Route::Node::get($call);
   if ($ref) {
     @out = print_all_fields($self, $ref, "Route::Node Information $call");
   } else {
-    push @out, "Route::User: $call not found";
+    push @out, "Route::Node: $call not found";
   }
   push @out, "" if @list > 1;
 }
diff --git a/cmd/stat/route_user.pl b/cmd/stat/route_user.pl
index 37a079b8..e39584cb 100644
--- a/cmd/stat/route_user.pl
+++ b/cmd/stat/route_user.pl
@@ -7,16 +7,29 @@
 #
 
 my ($self, $line) = @_;
+my @out;
 my @list = split /\s+/, $line;		      # generate a list of callsigns
 @list = ($self->call) if !@list;  # my channel if no callsigns
+if ($self->priv > 5 && @list && uc $list[0] eq 'ALL') {
+	push @out, "User Callsigns in Routing Table";
+	@list = sort map {$_->call} Route::User::get_all();
+	my $count = @list;
+	my $n = int $self->width / 10;
+	$n ||= 8;
+	while (@list > $n) {
+		push @out, join(' ', map {sprintf "%9s",$_ } splice(@list, 0, $n));
+	} 
+	push @out, join(' ', map {sprintf "%9s",$_ } @list) if @list;
+	push @out, "$count Users";
+	return (1, @out);
+}
 
 my $call;
-my @out;
 foreach $call (@list) {
   $call = uc $call;
   my $ref = Route::User::get($call);
   if ($ref) {
-    @out = print_all_fields($self, $ref, "Route::User Information $call");
+    push @out, print_all_fields($self, $ref, "Route::User Information $call");
   } else {
     push @out, "Route::User: $call not found";
   }
diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 15bd6d2b..fc779b0f 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -101,6 +101,7 @@ $count = 0;
 		  cq => '0,CQ Zone',
 		  enhanced => '5,Enhanced Client,yesno',
 		  senddbg => '8,Sending Debug,yesno',
+		  width => '0,Column Width',
 		 );
 
 use vars qw($VERSION $BRANCH);
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 96ccc0a4..b6140082 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -83,6 +83,8 @@ sub start
 	$self->{lang} = $user->lang || $main::lang || 'en';
 	$self->{pagelth} = $user->pagelth || 20;
 	$self->{priv} = 0 if $line =~ /^(ax|te)/; # set the connection priv to 0 - can be upgraded later
+	($self->{width}) = $line =~ /width=(\d+)/;
+	$self->{width} = 80 unless $self->{width} && $self->{width} > 80;
 	$self->{consort} = $line;	# save the connection type
 	
 	# set some necessary flags on the user if they are connecting
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index c5f4384c..4b7e1d9f 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -227,13 +227,14 @@ sub start
 	$self->{isolate} = $user->{isolate};
 	$self->{consort} = $line;	# save the connection type
 	$self->{here} = 1;
+	$self->{width} = 80;
 
 	# get the output filters
 	$self->{spotsfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'node_default', 0);
 	$self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'node_default', 0);
 	$self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'node_default', 0);
 	$self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'node_default', 0) ;
-	$self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) ;
+	$self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) unless $self->{isolate} ;
 
 
 	# get the INPUT filters (these only pertain to Clusters)
@@ -241,7 +242,7 @@ sub start
 	$self->{inwwvfilter} = Filter::read_in('wwv', $call, 1) || Filter::read_in('wwv', 'node_default', 1);
 	$self->{inwcyfilter} = Filter::read_in('wcy', $call, 1) || Filter::read_in('wcy', 'node_default', 1);
 	$self->{inannfilter} = Filter::read_in('ann', $call, 1) || Filter::read_in('ann', 'node_default', 1);
-	$self->{inroutefilter} = Filter::read_in('route', $call, 1) || Filter::read_in('route', 'node_default', 1);
+	$self->{inroutefilter} = Filter::read_in('route', $call, 1) || Filter::read_in('route', 'node_default', 1) unless $self->{isolate};
 	
 	# set unbuffered and no echo
 	$self->send_now('B',"0");
diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index 9a911b70..10b35387 100644
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -195,15 +195,17 @@ sub print_all_fields
 	my @out;
 	my @fields = $ref->fields;
 	my $field;
+	my $width = $self->width - 1;
+	$width ||= 80;
 
 	foreach $field (sort {$ref->field_prompt($a) cmp $ref->field_prompt($b)} @fields) {
 		if (defined $ref->{$field}) {
 			my ($priv, $ans) = promptf($ref->field_prompt($field), $ref->{$field});
 			my @tmp;
-			if (length $ans > 79) {
+			if (length $ans > $width) {
 				my ($p, $a) = split /: /, $ans, 2;
 				my $l = (length $p) + 2;
-				my $al = 79 - $l;
+				my $al = ($width - 1) - $l;
 				my $bit;
 				while (length $a > $al ) {
 					($bit, $a) = unpack "A$al A*", $a;
diff --git a/perl/Filter.pm b/perl/Filter.pm
index f9fa611a..11143825 100644
--- a/perl/Filter.pm
+++ b/perl/Filter.pm
@@ -517,7 +517,9 @@ sub cmd
 	return $dxchan->msg('filter5') unless $line;
 
 	my ($r, $filter, $fno, $user, $s) = $self->parse($dxchan, $sort, $line);
-	return (1,$filter) if $r;
+	my $u = DXUser->get_current($user);
+	return (1, $dxchan->msg('isow', $user)) if $u && $u->isolate;
+	return (1, $filter) if $r;
 
 	my $fn = "filter$fno";
 
diff --git a/perl/Messages b/perl/Messages
index da19dd3b..b6b0f67f 100644
--- a/perl/Messages
+++ b/perl/Messages
@@ -112,6 +112,9 @@ package DXM;
 				iso => '$_[0] Isolated',
 				isou => '$_[0] UnIsolated',
 				isoc => '$_[0] created and Isolated',
+				isoari => 'there is an input route filter for $_[0]; clear/route input $_[0] first',
+				isoaro => 'there is an output route filter for $_[0]; clear/route $_[0] first',
+				isow => '$_[0] is isolated; unset/isolate $_[0] first',
 				l1 => 'Sorry $_[0], you are already logged on on another channel',
 				l2 => 'Hello $_[0], this is $main::mycall in $main::myqth\nrunning DXSpider V$main::version build $main::build',
 				lang => 'Language is now $_[0]',
diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm
index 08b74c73..49e241dd 100644
--- a/perl/Route/Node.pm
+++ b/perl/Route/Node.pm
@@ -90,12 +90,12 @@ sub del
 
 	# delete parent from this call's parent list
 	$pref->_delnode($self);
-	my @ref = $self->_delparent($pref);
+    $self->_delparent($pref);
 	my @nodes;
 	my $ncall = $self->{call};
 	
 	# is this the last connection, I have no parents anymore?
-	unless (@ref) {
+	unless (@{$self->{parent}}) {
 		foreach my $rcall (@{$self->{nodes}}) {
 			next if grep $rcall eq $_, @_;
 			my $r = Route::Node::get($rcall);
diff --git a/perl/Route/User.pm b/perl/Route/User.pm
index e510a165..bcd98a00 100644
--- a/perl/Route/User.pm
+++ b/perl/Route/User.pm
@@ -59,12 +59,21 @@ sub new
 	return $self;
 }
 
+sub get_all
+{
+	return values %list;
+}
+
 sub del
 {
 	my $self = shift;
 	my $pref = shift;
-	my @out = $self->delparent($pref);
-	return @out;
+	$self->delparent($pref);
+	unless (@{$self->{parent}}) {
+		delete $list{$self->{call}};
+		return $self;
+	}
+	return undef;
 }
 
 sub get
diff --git a/perl/console.pl b/perl/console.pl
index e247d3c9..0996dc7a 100755
--- a/perl/console.pl
+++ b/perl/console.pl
@@ -450,7 +450,7 @@ do_initscr();
 
 $SIG{__DIE__} = \&sig_term;
 
-$conn->send_later("A$call|$connsort");
+$conn->send_later("A$call|$connsort width=$COLS");
 $conn->send_later("I$call|set/page $maxshist");
 $conn->send_later("I$call|set/nobeep");
 
-- 
2.34.1