X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute.pm;h=0f23d45531c1e40ba6aa9640931b232e01a338eb;hb=be8bb8ddece08d2893896418423a95548cbf316f;hp=afce3a042d850200af3b9478d8e6b88cd8527403;hpb=6230850db2f82835e5ef75da4f418615ba4261da;p=spider.git diff --git a/perl/Route.pm b/perl/Route.pm index afce3a04..0f23d455 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 @@ -285,34 +285,75 @@ sub get return Route::Node::get($call) || Route::User::get($call); } -# find all the possible dxchannels which this object might be on -sub alldxchan +sub findroutes { - 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; + my $call = shift; + my $level = shift || 0; + my $seen = shift || {}; + my @out; + + dbg("findroutes: $call level: $level calls: " . join(',', @_)) if isdbg('routec'); + + # recursion detector + return () if $seen->{$call}; + + # return immediately if we are directly connected + if (my $dxchan = DXChannel::get($call)) { + $seen->{$call}++; + push @out, $level ? [$level, $dxchan] : $dxchan; + return @out; + } + $seen->{$call}++; + + # deal with more nodes + 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} ? 0 : 30); + dbg("recursing from $call -> $ncall level $l") if isdbg('routec'); + my @rout = findroutes($ncall, $l+1, $seen); + push @out, @rout; + } + } + + 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 { - 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("ROUTE: findroute $call -> PC92C_dxchan " . $last->call) if $last; } } + push @nout, $last if @out == 0 && $last; + return @nout; + } else { + return @out; } -# dbg('routech', "Got dxchan: " . join(',', (map{ $_->call } @dxchan)) ); +} + +# find all the possible dxchannels which this object might be on +sub alldxchan +{ + my $self = shift; + my @dxchan = findroutes($self->{call}); return @dxchan; } @@ -328,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]; }