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.

diff --git a/Changes b/Changes
index bf1412d6b25b3451caac1c63c0acd1564830cfb7..a8fca892711eead92fff5471e844cd8800d0d2c5 100644 (file)
--- 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 3b706a73f5a024dd345e653e6940b69a1c0386b9..ab5f4e1c96882d6d2cde0801bbd94b4ded4e411c 100644 (file)
--- 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 9513a65e597a728651dd2db45415595a20dbf7eb..89d8257b0fe5f71d3e1afa692eaaca3d7f8bed2d 100644 (file)
--- 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 1cedcb4409a47674c3cc1e4c5c6e2850a0bb7364..c546e60167112ba666371d1770bd25fb2479b492 100644 (file)
--- 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 37a079b8cc455e97793f2b137e0a95f6d4f7b932..e39584cb0877cef3bf8febfd875497380a554ff1 100644 (file)
--- 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 15bd6d2bffccbbcc994a22825d3545771831a0e0..fc779b0f63ca46172b952610e129621eaa926117 100644 (file)
--- 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 96ccc0a494aa872575064fee0a22cee274ad30c9..b6140082f6a741b59ab5ece9541823213e2eafaa 100644 (file)
--- 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 c5f4384cdfc74fcf8618eb481189404b98415964..4b7e1d9f3cafffd3e6e53680dc5fcd3c8f7cb0e3 100644 (file)
--- 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 9a911b70e4f6dccc2c7968bc9e4523d0ce4734f1..10b3538767822ef46735fb4cc2a8b267e7a8c024 100644 (file)
--- 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 f9fa611a8ef37ad4d931d4d1a4a862d8fc4fa1a7..11143825710de95d30a2f649a6449986fb34193d 100644 (file)
--- 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 da19dd3b8ac7497344039ad13843bcda55a6861e..b6b0f67f5ee702de80af7c250b641f6aca139c2c 100644 (file)
--- 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 08b74c737295b15006a959e431a0eaa34b19fd42..49e241dddf5b6b7ef265861a5d2498da1c0af903 100644 (file)
--- 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 e510a165e2736e1d78cac926f419a0678716e192..bcd98a00ed3e591c86a995ad3f8c8be1abebd794 100644 (file)
--- 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 e247d3c96791ebde87b35945124e89455f6fb9d2..0996dc7a8285e9c3564139aed3e3fd6234fb6aad 100755 (executable)
--- 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");