change node disconnection code to improve node clearouts

[spider.git] / perl / Route.pm

diff --git a/perl/Route.pm b/perl/Route.pm
index 72bb5db44b8afb42b7c3319dabfd41ab21b9430d..290cd7628f10823e61611398bf48a8b95de9ba2c 100644 (file)
--- a/perl/Route.pm
+++ b/perl/Route.pm
@@ -9,7 +9,7 @@
 #
 # Copyright (c) 2001 Dirk Koopman G1TLH
 #
-# $Id$
+#
 #
 
 package Route;
@@ -200,7 +200,7 @@ sub config
                $pcall .= ":" . $self->obscount if isdbg('obscount');
 
 
-               $line = ' ' x ($level*2) . "$pcall";
+               $line = ' ' x ($level*2) . $pcall;
                $pcall = ' ' x length $pcall;
 
                # recursion detector
@@ -305,6 +305,7 @@ sub findroutes
 
        # deal with more nodes
        my $nref = Route::get($call);
+       return () unless $nref;
        foreach my $ncall (@{$nref->{parent}}) {
                unless ($seen->{$ncall}) {
                        dbg("recursing from $call -> $ncall") if isdbg('routec');
@@ -313,7 +314,34 @@ sub findroutes
                }
        }
 
-       return $level == 0 ? map {$_->[1]} sort {$a->[0] <=> $b->[0]} @out : @out;
+       if ($level == 0) {
+               my @nout = map {$_->[1]} sort {$a->[0] <=> $b->[0]} @out;
+               my $last;
+               if ($nref->isa('Route::Node')) {
+                       my $ncall = $nref->PC92C_dxchan;
+                       $last = DXChannel::get($ncall) if $ncall;
+               } else {
+                       my $pcall = $nref->{parent}->[0];
+                       my ($ref, $ncall);
+                       $ref = Route::Node::get($pcall) if $pcall;
+                       $ncall = $ref->PC92C_dxchan if $ref;
+                       $last = DXChannel::get($ncall) if $ncall;
+               }
+
+               if (isdbg('findroutes')) {
+                       if (@out) {
+                               foreach (sort {$a->[0] <=> $b->[0]} @out) {
+                                       dbg("ROUTE: findroute $call -> $_->[0] " . $_->[1]->call);
+                               }
+                       } else {
+                               dbg("ROUTE: findroute $call -> PC92C_dxchan " . $last->call) if $last;
+                       }
+               }
+               push @nout, $last if @out == 0 && $last;
+               return @nout;
+       } else {
+               return @out;
+       }
 }
 
 # find all the possible dxchannels which this object might be on