mirror of
git://scm.dxcluster.org/scm/spider
synced 2024-09-21 07:47:10 +00:00
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:
parent
7a3918d750
commit
c1540ccd79
4
Changes
4
Changes
@ -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=======================================================================
|
||||
|
@ -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.
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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;
|
||||
}
|
||||
|
||||
|
@ -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);
|
||||
|
@ -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);
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
117
perl/Route.pm
117
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.
|
||||
@ -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
|
||||
{
|
||||
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
|
@ -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;
|
||||
|
145
perl/RouteDB.pm
145
perl/RouteDB.pm
@ -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;
|
@ -11,6 +11,6 @@ use vars qw($version $subversion $build);
|
||||
|
||||
$version = '1.55';
|
||||
$subversion = '0';
|
||||
$build = '13';
|
||||
$build = '14';
|
||||
|
||||
1;
|
||||
|
@ -98,7 +98,6 @@ use Mrtg;
|
||||
use USDB;
|
||||
use UDPMsg;
|
||||
use QSL;
|
||||
use RouteDB;
|
||||
use DXXml;
|
||||
use DXSql;
|
||||
use IsoTime;
|
||||
|
Loading…
Reference in New Issue
Block a user