New improved route finding algorithm

This is what Changes says:

Change the route finding algorithm completely. No more recursion. No more
tree searching. It now gives you answers even on a partial cluster map. Oh
and the answers are correct, instead on completely random.

Also completely remove RouteDB from the equation.
Also change sh/newc to default to node map rather than node+user map.
This commit is contained in:
Dirk Koopman 2008-06-24 19:36:57 +01:00
parent 7a3918d750
commit c1540ccd79
14 changed files with 102 additions and 313 deletions

View File

@ -1,3 +1,7 @@
24Jun08=======================================================================
1. Change the route finding algorithm completely. No more recursion. No more
tree searching. It now gives you answers even on a partial cluster map. Oh
and the answers are correct, instead on completely random.
28May08=======================================================================
1. remove "recursion limit" message from Route.pm
28May08=======================================================================

View File

@ -2331,17 +2331,18 @@ So if you have said: ACC/SPOT on hf
Doing a SHOW/MYDX will now only, ever, show HF spots. All the other
options on SH/DX can still be used.
=== 0^SHOW/NEWCONFIGURATION [<node>]^Show all the nodes and users visible
This command allows you to see all the users that can be seen
and the nodes to which they are connected.
=== 0^SHOW/NEWCONFIGURATION [USERS|<node call>]^Show the cluster map
Show the map of the whole cluster.
This command produces essentially the same information as
SHOW/CONFIGURATION except that it shows all the duplication of
any routes that might be present It also uses a different format
which may not take up quite as much space if you don't have any
loops.
This shows the structure of the cluster that you are connected to. By
default it will only show the nodes that are known. By adding the keyword
USER to the command it will show all the users as well.
BE WARNED: the list that is returned can be VERY long
As there will be loops, you will see '...', this means that the information
is as printed earlier and that is a looped connection from here on.
BE WARNED: the list that is returned can be VERY long (particularly
with the USER keyword)
=== 0^SHOW/NEWCONFIGURATION/NODE^Show all the nodes connected locally
Show all the nodes connected to this node in the new format.

View File

@ -21,7 +21,6 @@ return (1, $self->msg('pinge1')) if $call eq $main::mycall;
# can we see it? Is it a node?
my $noderef = Route::Node::get($call);
$noderef = RouteDB::get($call) unless $noderef;
return (1, $self->msg('e7', $call)) unless $noderef;

View File

@ -9,10 +9,10 @@
my ($self, $line) = @_;
my @list = map { uc } split /\s+/, $line; # list of callsigns of nodes
my @out;
my $nodes_only;
my $nodes_only = 1;
if (@list && $list[0] =~ /^NOD/) {
$nodes_only++;
if (@list && $list[0] =~ /^USE/) {
$nodes_only = 0;
shift @list;
}

View File

@ -12,8 +12,6 @@ my @out;
return (1, $self->msg('e6')) unless @list;
use RouteDB;
my $l;
foreach $l (@list) {
my $ref = Route::get($l);
@ -23,13 +21,6 @@ foreach $l (@list) {
} else {
push @out, $self->msg('e7', $l);
}
my @in = RouteDB::_sorted($l);
if (@in) {
push @out, "Learned Routes:";
for (@in) {
push @out, "$l via $_->{call} count: $_->{count} last heard: " . atime($_->{t});
}
}
}
return (1, @out);

View File

@ -32,7 +32,6 @@ use DXHash;
use Route;
use Route::Node;
use Script;
use RouteDB;
use DXProtHandle;
use strict;
@ -1037,19 +1036,6 @@ sub route
}
}
# try the backstop method
unless ($dxchan) {
my $rcall = RouteDB::get($call);
if ($rcall) {
if ($self && $rcall eq $self->{call}) {
dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr');
return;
}
$dxchan = DXChannel::get($rcall);
dbg("route: $call -> $rcall using RouteDB" ) if isdbg('route') && $dxchan;
}
}
if ($dxchan) {
my $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name
if ($routeit) {
@ -1228,7 +1214,7 @@ sub disconnect
# do routing stuff, remove me from routing table
my $node = Route::Node::get($call);
RouteDB::delete_interface($call);
Route::delete_interface($call);
# unbusy and stop and outgoing mail
my $mref = DXMsg::get_busy($call);

View File

@ -32,8 +32,6 @@ use DXHash;
use Route;
use Route::Node;
use Script;
use RouteDB;
use strict;
@ -122,10 +120,6 @@ sub handle_10
}
}
# remember a route to this node and also the node on which this user is
RouteDB::update($_[6], $self->{call});
# RouteDB::update($to, $_[6]);
# convert this to a PC93, coming from mycall with origin set and process it as such
$main::me->normal(pc93($to, $from, $via, $_[3], $_[6]));
}
@ -203,10 +197,6 @@ sub handle_11
}
}
# remember a route
# RouteDB::update($_[7], $self->{call});
# RouteDB::update($_[6], $_[7]);
my @spot = Spot::prepare($_[1], $_[2], $d, $_[5], $nossid, $_[7]);
# global spot filtering on INPUT
if ($self->{inspotsfilter}) {
@ -338,10 +328,6 @@ sub handle_12
$self->send_chat(0, $line, @_[1..6]);
} elsif ($_[2] eq '*' || $_[2] eq $main::mycall) {
# remember a route
# RouteDB::update($_[5], $self->{call});
# RouteDB::update($_[1], $_[5]);
# ignore something that looks like a chat line coming in with sysop
# flag - this is a kludge...
if ($_[3] =~ /^\#\d+ / && $_[4] eq '*') {
@ -422,7 +408,6 @@ sub handle_16
my $h;
$h = 1 if DXChannel::get($ncall);
RouteDB::update($ncall, $self->{call}, $h);
if ($h && $self->{call} ne $ncall) {
dbg("PCPROT: trying to update a local node, ignored") if isdbg('chanerr');
return;
@ -542,8 +527,6 @@ sub handle_17
return;
}
RouteDB::delete($ncall, $self->{call});
my $uref = Route::User::get($ucall);
unless ($uref) {
dbg("PCPROT: Route::User $ucall not in config") if isdbg('chanerr');
@ -737,7 +720,6 @@ sub handle_19
# next;
# }
RouteDB::update($call, $self->{call}, $dxchan ? 1 : undef);
unless ($h) {
if ($parent->via_pc92) {
@ -843,8 +825,6 @@ sub handle_21
# we don't need any isolation code here, because we will never
# act on a PC21 with self->call in it.
RouteDB::delete($call, $self->{call});
my $parent = Route::Node::get($self->{call});
unless ($parent) {
dbg("PCPROT: my parent $self->{call} has disappeared");
@ -1241,13 +1221,12 @@ sub handle_50
my $call = $_[1];
RouteDB::update($call, $self->{call});
my $node = Route::Node::get($call);
if ($node) {
return unless $node->call eq $self->{call};
$node->usercount($_[2]) unless $node->users;
$node->reset_obs;
$node->PC92C_dxchan($self->call, $_[-1]);
# input filter if required
# return unless $self->in_filter_route($node);
@ -1279,9 +1258,6 @@ sub handle_51
DXXml::Ping::handle_ping_reply($self, $from);
}
} else {
RouteDB::update($from, $self->{call});
if (eph_dup($line)) {
return;
}
@ -1415,6 +1391,9 @@ sub _add_thingy
{
my $parent = shift;
my $s = shift;
my $dxchan = shift;
my $hops = shift;
my ($call, $is_node, $is_extnode, $here, $version, $build) = @$s;
my @rout;
@ -1422,6 +1401,8 @@ sub _add_thingy
if ($is_node) {
dbg("ROUTE: added node $call to " . $parent->call) if isdbg('routelow');
@rout = $parent->add($call, $version, Route::here($here));
my $r = Route::Node::get($call);
$r->PC92C_dxchan($dxchan->call, $hops) if $r;
} else {
dbg("ROUTE: added user $call to " . $parent->call) if isdbg('routelow');
@rout = $parent->add_user($call, Route::here($here));
@ -1579,6 +1560,7 @@ sub pc92_handle_first_slot
my $slot = shift;
my $parent = shift;
my $t = shift;
my $hops = shift;
my $oparent = $parent;
my @radd;
@ -1603,7 +1585,7 @@ sub pc92_handle_first_slot
# from the true parent node for this external before we get one for the this node
unless ($parent = Route::Node::get($call)) {
if ($is_extnode && $oparent) {
@radd = _add_thingy($oparent, $slot);
@radd = _add_thingy($oparent, $slot, $self, $hops);
$parent = $radd[0];
} else {
dbg("PCPROT: no previous C or A for this external node received, ignored") if isdbg('chanerr');
@ -1612,7 +1594,7 @@ sub pc92_handle_first_slot
}
$parent = check_pc9x_t($call, $t, 92) || return;
$parent->via_pc92(1);
$parent->PC92C_dxchan($self->{call});
$parent->PC92C_dxchan($self->{call}, $hops);
}
} else {
dbg("PCPROT: must be \$mycall or external node as first entry, ignored") if isdbg('chanerr');
@ -1621,7 +1603,7 @@ sub pc92_handle_first_slot
$parent->here(Route::here($here));
$parent->version($version || $pc19_version) if $version;
$parent->build($build) if $build;
$parent->PC92C_dxchan($self->{call}) unless $self->{call} eq $parent->call;
$parent->PC92C_dxchan($self->{call}, $hops) unless $self->{call} eq $parent->call;
return ($parent, @radd);
}
@ -1638,6 +1620,7 @@ sub handle_92
my $pcall = $_[1];
my $t = $_[2];
my $sort = $_[3];
my $hops = $_[-1];
# this catches loops of A/Ds
# if (eph_dup($line, $pc9x_dupe_age)) {
@ -1722,14 +1705,14 @@ sub handle_92
$pc92Kin += length $line;
# remember the last channel we arrived on
$parent->PC92C_dxchan($self->{call}) unless $self->{call} eq $parent->call;
$parent->PC92C_dxchan($self->{call}, $hops) unless $self->{call} eq $parent->call;
my @ent = _decode_pc92_call($_[4]);
if (@ent) {
my $add;
($parent, $add) = $self->pc92_handle_first_slot(\@ent, $parent, $t);
($parent, $add) = $self->pc92_handle_first_slot(\@ent, $parent, $t, $hops);
return unless $parent; # dupe
push @radd, $add if $add;
@ -1746,7 +1729,7 @@ sub handle_92
$pc92Din += length $line if $sort eq 'D';
# remember the last channel we arrived on
$parent->PC92C_dxchan($self->{call}) unless $self->{call} eq $parent->call;
$parent->PC92C_dxchan($self->{call}, $hops) unless $self->{call} eq $parent->call;
# this is the main route section
# here is where all the routes are created and destroyed
@ -1765,7 +1748,7 @@ sub handle_92
# that needs to be done.
my $add;
($parent, $add) = $self->pc92_handle_first_slot($ent[0], $parent, $t);
($parent, $add) = $self->pc92_handle_first_slot($ent[0], $parent, $t, $hops);
return unless $parent; # dupe
shift @ent;
@ -1785,7 +1768,7 @@ sub handle_92
if ($sort eq 'A') {
for (@nent) {
push @radd, _add_thingy($parent, $_);
push @radd, _add_thingy($parent, $_, $self, $hops);
}
} elsif ($sort eq 'D') {
for (@nent) {
@ -1818,7 +1801,7 @@ sub handle_92
foreach my $r (@nent) {
my $call = $r->[0];
if ($call) {
push @radd,_add_thingy($parent, $r) if grep $call eq $_, (@$nnodes, @$nusers);
push @radd,_add_thingy($parent, $r, $self, $hops) if grep $call eq $_, (@$nnodes, @$nusers);
}
}
# del users here

View File

@ -20,7 +20,7 @@ use vars qw(@month %patmap @ISA @EXPORT);
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf
parray parraypairs phex shellregex readfilestr writefilestr
parray parraypairs phex phash shellregex readfilestr writefilestr
filecopy ptimelist
print_all_fields cltounix unpad is_callsign is_latlong
is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem
@ -194,7 +194,7 @@ sub parraypairs
my $ref = shift;
my $i;
my $out;
for ($i = 0; $i < @$ref; $i += 2) {
my $r1 = @$ref[$i];
my $r2 = @$ref[$i+1];
@ -205,6 +205,20 @@ sub parraypairs
return $out;
}
# take the arg as a hash reference and print it out as such
sub phash
{
my $ref = shift;
my $out;
while (my ($k,$v) = each %$ref) {
$out .= "${k}=>$v, ";
}
chop $out; # remove last space
chop $out; # remove last comma
return $out;
}
sub _sort_fields
{
my $ref = shift;

View File

@ -238,15 +238,6 @@ sub route
dbg("route: $via -> $dxchan->{call} using normal route" ) if isdbg('route');
}
# try the backstop method
unless ($dxchan) {
my $rcall = RouteDB::get($via);
if ($rcall) {
$dxchan = DXChannel::get($rcall);
dbg("route: $via -> $rcall using RouteDB" ) if isdbg('route') && $dxchan;
}
}
unless ($dxchan) {
dbg("XML: no route available to $via") if isdbg('chanerr');
return;

View File

@ -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.
@ -286,92 +286,52 @@ sub get
return Route::Node::get($call) || Route::User::get($call);
}
# this may be a better algorithm
#start = {start node}
#end = {end node}
#dist = 0
#marked(n) = false for all nodes n
#queue = [start]
#while queue is not empty:
# dist = dist + 1
# newqueue = []
# for each node n in queue:
# for each edge from node n to node m:
# if not marked(m):
# marked(m) = true
# if m == end:
# -- We've found the end node
# -- it's a distance "dist" from the start
# return dist
# add m to newqueue
# queue = newqueue
sub findroutes
{
my $call = shift;
my $level = shift || 0;
my $seen = shift || {};
my @out;
dbg("findroutes: $call level: $level calls: " . join(',', @_)) if isdbg('routec');
# recursion detector (no point in recursing that deeply)
return () if $seen->{$call};
if ($level >= 20) {
# dbg("Route::findroutes: recursion limit reached looking for $call");
return ();
}
dbg("ROUTE: findroutes: $call") if isdbg('findroutes');
# return immediately if we are directly connected
if (my $dxchan = DXChannel::get($call)) {
$seen->{$call}++;
push @out, $level ? [$level, $dxchan] : $dxchan;
return @out;
return $dxchan;
}
$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} && ($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;
}
}
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;
# obtain the dxchannels that have seen this thingy
my @parent = $nref->isa('Route::User') ? @{$nref->{parent}} : $call;
my %cand;
foreach my $p (@parent) {
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);
}
}
push @nout, $last if @out == 0 && $last;
return @nout;
} else {
return @out;
}
# 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 = map {$_->[1]} sort {$b->[0] <=> $a->[0]} @out;
if (isdbg('findroutes')) {
if (@out) {
foreach (sort {$b->[0] <=> $a->[0]} @out) {
dbg("ROUTE: findroute $call -> $_->[0] " . $_->[1]->call);
}
}
}
return @nout;
}
# find all the possible dxchannels which this object might be on
@ -393,21 +353,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
{
}
#

View File

@ -32,7 +32,7 @@ use vars qw(%list %valid @ISA $max $filterdef $obscount);
via_pc92 => '0,Came in via pc92,yesno',
obscount => '0,Obscount',
last_PC92C => '9,Last PC92C',
PC92C_dxchan => '9,Channel of PC92C',
PC92C_dxchan => '9,Channel of PC92C,phash',
);
$filterdef = $Route::filterdef;
@ -286,7 +286,7 @@ sub new
$self->{flags} = shift || Route::here(1);
$self->{users} = [];
$self->{nodes} = [];
$self->{PC92C_dxchan} = '';
$self->{PC92C_dxchan} = {};
$self->reset_obs; # by definition
$list{$call} = $self;
@ -371,6 +371,19 @@ sub measure_pc9x_t
}
}
sub PC92C_dxchan
{
my $parent = shift;
my $call = shift;
my $hops = shift;
if ($call && $hops) {
$hops =~ s/^H//;
$parent->{PC92C_dxchan}->{$call} = $hops;
return;
}
return (%{$parent->{PC92C_dxchan}});
}
sub DESTROY
{
my $self = shift;

View File

@ -1,145 +0,0 @@
# This module is used to keep a list of where things come from
#
# all interfaces add/update entries in here to allow casual
# routing to occur.
#
# It is up to the protocol handlers in here to make sure that
# this information makes sense.
#
# This is (for now) just an adjunct to the normal routing
# and is experimental. It will override filtering for
# things that are explicitly routed (pings, talks and
# such like).
#
# Copyright (c) 2004 Dirk Koopman G1TLH
#
#
#
package RouteDB;
use DXDebug;
use DXChannel;
use DXUtil;
use Prefix;
use strict;
use vars qw(%list %valid $default);
%list = ();
$default = 99; # the number of hops to use if we don't know
%valid = (
call => "0,Callsign",
item => "0,Interfaces,parray",
t => '0,Last Seen,atime',
hops => '0,Hops',
count => '0,Times Seen',
);
sub new
{
my $pkg = shift;
my $call = shift;
return bless {call => $call, list => {}}, (ref $pkg || $pkg);
}
# get the best one
sub get
{
my @out = _sorted(shift);
return @out ? $out[0]->{call} : undef;
}
# get all of them in sorted order
sub get_all
{
my @out = _sorted(shift);
return @out ? map { $_->{call} } @out : ();
}
# get them all, sorted into reverse occurance order (latest first)
# with the smallest hops
sub _sorted
{
my $call = shift;
my $ref = $list{$call};
return () unless $ref;
return sort {
if ($a->{hops} == $b->{hops}) {
$b->{t} <=> $a->{t};
} else {
$a->{hops} <=> $b->{hops};
}
} values %{$ref->{item}};
}
# add or update this call on this interface
#
# RouteDB::update($call, $interface, $hops, time);
#
sub update
{
my $call = shift;
my $interface = shift;
my $hops = shift || $default;
my $ref = $list{$call} || RouteDB->new($call);
my $iref = $ref->{item}->{$interface} ||= RouteDB::Item->new($interface, $hops);
$iref->{count}++;
$iref->{hops} = $hops if $hops < $iref->{hops};
$iref->{t} = shift || $main::systime;
$ref->{item}->{$interface} ||= $iref;
$list{$call} ||= $ref;
}
sub delete
{
my $call = shift;
my $interface = shift;
my $ref = $list{$call};
delete $ref->{item}->{$interface} if $ref;
}
sub delete_interface
{
my $interface = shift;
foreach my $ref (values %list) {
delete $ref->{item}->{$interface};
}
}
#
# generic AUTOLOAD for accessors
#
sub AUTOLOAD
{
no strict;
my $name = $AUTOLOAD;
return if $name =~ /::DESTROY$/;
$name =~ s/^.*:://o;
confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
# this clever line of code creates a subroutine which takes over from autoload
# from OO Perl - Conway
*{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
goto &$AUTOLOAD;
}
package RouteDB::Item;
use vars qw(@ISA);
@ISA = qw(RouteDB);
sub new
{
my $pkg = shift;
my $call = shift;
my $hops = shift || $RouteDB::default;
return bless {call => $call, hops => $hops}, (ref $pkg || $pkg);
}
1;

View File

@ -11,6 +11,6 @@ use vars qw($version $subversion $build);
$version = '1.55';
$subversion = '0';
$build = '13';
$build = '14';
1;

View File

@ -98,7 +98,6 @@ use Mrtg;
use USDB;
use UDPMsg;
use QSL;
use RouteDB;
use DXXml;
use DXSql;
use IsoTime;