X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute.pm;h=abc098471e7edaf0e7a721887a778359a77b3571;hb=709a22cc74af221af2b60494866c5a01e5ac1a6c;hp=1106892a167c8641147ac76fa02d9118a13057eb;hpb=916f0deef0e085647471d5959a55c2ddb815a044;p=spider.git diff --git a/perl/Route.pm b/perl/Route.pm index 1106892a..abc09847 100644 --- 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 @@ -296,51 +296,64 @@ sub findroutes # recursion detector return () if $seen->{$call}; + + # return immediately if we are directly connected if (my $dxchan = DXChannel::get($call)) { $seen->{$call}++; - push @out, [$level, $dxchan]; + push @out, $level ? [$level, $dxchan] : $dxchan; return @out; } + $seen->{$call}++; # deal with more nodes - my $nref = Route::Node::get($call); - foreach my $ncall (@{$nref->{nodes}}) { - dbg("recursing from $call -> $ncall") if isdbg('routec'); - my @rout = findroute($ncall, $level+1, $seen); - push @out, @rout; + my $nref = Route::get($call); + return () unless $nref; + foreach my $ncall (@{$nref->{parent}}) { + unless ($seen->{$ncall}) { + + # put non-pc9x nodes to the back of the queue + my $l = $level + ($nref->{do_pc9x} && ($nref->{version}||5454) >= 5454 ? 0 : 30); + dbg("recursing from $call -> $ncall level $l") if isdbg('routec'); + my @rout = findroutes($ncall, $l+1, $seen); + push @out, @rout; + } } - 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 sub alldxchan { my $self = shift; - my @dxchan; -# dbg("Trying node $self->{call}") if isdbg('routech'); - - my $dxchan = DXChannel::get($self->{call}); - push @dxchan, $dxchan if $dxchan; - - # it isn't, build up a list of dxchannels and possible ping times - # for all the candidates. - unless (@dxchan) { - foreach my $p (@{$self->{parent}}) { -# dbg("Trying parent $p") if isdbg('routech'); - next if $p eq $main::mycall; # the root - my $dxchan = DXChannel::get($p); - if ($dxchan) { - push @dxchan, $dxchan unless grep $dxchan == $_, @dxchan; - } else { - next if grep $p eq $_, @_; - my $ref = Route::Node::get($p); -# dbg("Next node $p " . ($ref ? 'Found' : 'NOT Found') if isdbg('routech') ); - push @dxchan, $ref->alldxchan($self->{call}, @_) if $ref; - } - } - } -# dbg('routech', "Got dxchan: " . join(',', (map{ $_->call } @dxchan)) ); + my @dxchan = findroutes($self->{call}); return @dxchan; } @@ -356,16 +369,18 @@ sub dxchan return undef unless @dxchan; # determine the minimum ping channel - my $minping = 99999999; - foreach my $dxc (@dxchan) { - my $p = $dxc->pingave; - if (defined $p && $p < $minping) { - $minping = $p; - $dxchan = $dxc; - } - } - $dxchan = shift @dxchan unless $dxchan; - return $dxchan; +# my $minping = 99999999; +# foreach my $dxc (@dxchan) { +# my $p = $dxc->pingave; +# if (defined $p && $p < $minping) { +# $minping = $p; +# $dxchan = $dxc; +# } +# } +# $dxchan = shift @dxchan unless $dxchan; + + # dxchannels are now returned in order of "closeness" + return $dxchan[0]; }