X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute.pm;h=304b9c6830b97f77bde4767cc64ad954c2a310e1;hb=4b207544da78b182bd12e94eab01451694749012;hp=290cd7628f10823e61611398bf48a8b95de9ba2c;hpb=fb9c2ab04977b4e685b0eca3b2a2d04a77f65f4b;p=spider.git diff --git a/perl/Route.pm b/perl/Route.pm index 290cd762..304b9c68 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. @@ -22,9 +22,10 @@ use DXUtil; use strict; -use vars qw(%list %valid $filterdef); +use vars qw(%list %valid $filterdef $maxlevel); %valid = ( + parent => '0,Parent Calls,parray', call => "0,Callsign", flags => "0,Flags,phex", dxcc => '0,Country Code', @@ -32,6 +33,7 @@ use vars qw(%list %valid $filterdef); cq => '0,CQ Zone', state => '0,State', city => '0,City', + ip => '0,IP Address', ); $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; @@ -204,7 +208,7 @@ sub config $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,62 @@ 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 ? [$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}) { - dbg("recursing from $call -> $ncall") if isdbg('routec'); - my @rout = findroutes($ncall, $level+1, $seen); - push @out, @rout; + + # 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; + } + + # 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); + } } } - 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; + # remove any dxchannels that have gone away + while (my ($k, $v) = each %cand) { + if (my $dxc = DXChannel::get($k)) { + push @out, [$v, $dxc]; } + } - 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; + # 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); } } - push @nout, $last if @out == 0 && $last; - return @nout; - } else { - return @out; } + + return @nout; } # find all the possible dxchannels which this object might be on @@ -349,7 +361,7 @@ sub alldxchan { my $self = shift; my @dxchan = findroutes($self->{call}); - return @dxchan; + return map {$_->[1]} @dxchan; } sub dxchan @@ -363,22 +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; - # dxchannels are now returned in order of "closeness" return $dxchan[0]; } +sub delete_interface +{ +} # # track destruction