X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?p=spider.git;a=blobdiff_plain;f=perl%2FRoute.pm;h=a8820ea4fd228510d28f345ecc6913184ee2abd5;hp=1106892a167c8641147ac76fa02d9118a13057eb;hb=48f0cb90d0cfbe3037f353fc25adfc33561634fa;hpb=916f0deef0e085647471d5959a55c2ddb815a044 diff --git a/perl/Route.pm b/perl/Route.pm index 1106892a..a8820ea4 100644 --- a/perl/Route.pm +++ b/perl/Route.pm @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# # # This module impliments the abstracted routing for all protocols and # is probably what I SHOULD have done the first time. @@ -9,7 +9,7 @@ # # Copyright (c) 2001 Dirk Koopman G1TLH # -# $Id$ +# # package Route; @@ -22,16 +22,18 @@ use DXUtil; use strict; -use vars qw(%list %valid $filterdef); +use vars qw(%list %valid $filterdef $maxlevel); %valid = ( call => "0,Callsign", - flags => "0,Flags,phex", + city => '0,City', + cq => '0,CQ Zone', dxcc => '0,Country Code', + flags => "0,Flags,phex", + ip => '0,IP Address', itu => '0,ITU Zone', - cq => '0,CQ Zone', + parent => '0,Parent Calls,parray', state => '0,State', - city => '0,City', ); $filterdef = bless ([ @@ -53,6 +55,7 @@ $filterdef = bless ([ ['by_state', 'ns', 9], ], 'Filter::Cmd'); +$maxlevel = 25; # maximum recursion level in Route::config sub new { @@ -181,6 +184,7 @@ sub config { my $self = shift; my $nodes_only = shift || 0; + my $width = shift || 79; my $level = shift; my $seen = shift; my @out; @@ -200,11 +204,11 @@ sub config $pcall .= ":" . $self->obscount if isdbg('obscount'); - $line = ' ' x ($level*2) . "$pcall"; + $line = ' ' x ($level*2) . $pcall; $pcall = ' ' x length $pcall; # recursion detector - if ((DXChannel::get($call) && $level > 1) || $seen->{$call}) { + if ((DXChannel::get($call) && $level > 1) || $seen->{$call} || $level > $maxlevel) { $line .= ' ...'; push @out, $line; return @out; @@ -220,12 +224,14 @@ sub config my $c; if ($uref) { $c = $uref->user_call; - } else { + } + else { $c = "$ucall?"; } - if ((length $line) + (length $c) + 1 < 79) { + if ((length $line) + (length $c) + 1 < $width) { $line .= $c . ' '; - } else { + } + else { $line =~ s/\s+$//; push @out, $line; $line = ' ' x ($level*2) . "$pcall->$c "; @@ -236,9 +242,10 @@ sub config $line =~ s/->$//g; $line =~ s/\s+$//; push @out, $line if length $line; - } else { + } + else { # recursion detector - if ((DXChannel::get($call) && $level > 1) || $seen->{$call}) { + if ((DXChannel::get($call) && $level > 1) || $seen->{$call} || $level > $maxlevel) { return @out; } $seen->{$call}++; @@ -251,7 +258,7 @@ sub config if ($nref) { my $c = $nref->user_call; dbg("recursing from $call -> $c") if isdbg('routec'); - my @rout = $nref->config($nodes_only, $level+1, $seen, @_); + my @rout = $nref->config($nodes_only, $width, $level+1, $seen, @_); if (@rout && @_) { push @out, ' ' x ($level*2) . $self->user_call unless grep /^\s+$call/, @out; } @@ -268,11 +275,14 @@ sub cluster { my $nodes = Route::Node::count(); my $tot = Route::User::count(); - my $users = scalar DXCommandmode::get_all(); + my ($users, $maxlocalusers) = DXCommandmode::user_count(); # the user count is wrong because of skimmers my $maxusers = Route::User::max(); my $uptime = main::uptime(); + my $localnodes = $DXChannel::count - $users; # this is now wrong because of skimmers + + return ($nodes, $tot, $users, $maxlocalusers, $maxusers, $uptime, $localnodes); + - return " $nodes nodes, $users local / $tot total users Max users $maxusers Uptime $uptime"; } # @@ -288,60 +298,70 @@ sub get sub findroutes { my $call = shift; - my $level = shift || 0; - my $seen = shift || {}; + my %cand; my @out; - dbg("findroutes: $call level: $level calls: " . join(',', @_)) if isdbg('routec'); + dbg("ROUTE: findroutes $call") if isdbg('findroutes'); - # recursion detector - return () if $seen->{$call}; - if (my $dxchan = DXChannel::get($call)) { - $seen->{$call}++; - push @out, [$level, $dxchan]; - return @out; + my $nref = Route::get($call); + return () unless $nref; + + # we are directly connected, force "best possible" priority, but + # carry on in case user is connected on other nodes. + my $dxchan = DXChannel::get($call); + if ($dxchan) { + dbg("ROUTE: findroutes $call -> directly connected") if isdbg('findroutes'); + $cand{$call} = 99; } - # 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; + # obtain the dxchannels that have seen this thingy + my @parent = $nref->isa('Route::User') ? @{$nref->{parent}} : $call; + foreach my $p (@parent) { + next if $p eq $main::mycall; # this is dealt with above + + # deal with directly connected nodes, again "best priority" + $dxchan = DXChannel::get($p); + if ($dxchan) { + dbg("ROUTE: findroutes $call -> connected direct via parent $p") if isdbg('findroutes'); + $cand{$p} = 99; + next; + } + + my $r = Route::Node::get($p); + if ($r) { + my %r = $r->PC92C_dxchan; + while (my ($k, $v) = each %r) { + $cand{$k} = $v if $v > ($cand{$k} || 0); + } + } + } + + # remove any dxchannels that have gone away + while (my ($k, $v) = each %cand) { + if (my $dxc = DXChannel::get($k)) { + push @out, [$v, $dxc]; + } + } + + # get a sorted list of dxchannels with the highest hop count first + my @nout = sort {$b->[0] <=> $a->[0]} @out; + if (isdbg('findroutes')) { + if (@nout) { + for (@nout) { + dbg("ROUTE: findroutes $call -> $_->[0] " . $_->[1]->call); + } + } } - return $level == 0 ? map {$_->[1]} sort {$a->[0] <=> $b->[0]} @out : @out; + return @nout; } # 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)) ); - return @dxchan; + my @dxchan = findroutes($self->{call}); + return map {$_->[1]} @dxchan; } sub dxchan @@ -355,20 +375,14 @@ sub dxchan my @dxchan = $self->alldxchan; 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; + # dxchannels are now returned in order of "closeness" + return $dxchan[0]; } +sub delete_interface +{ +} # # track destruction