+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=======================================================================
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.
# 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;
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;
}
return (1, $self->msg('e6')) unless @list;
-use RouteDB;
-
my $l;
foreach $l (@list) {
my $ref = Route::get($l);
} 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);
use Route;
use Route::Node;
use Script;
-use RouteDB;
use DXProtHandle;
use strict;
}
}
- # 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) {
# 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);
use Route;
use Route::Node;
use Script;
-use RouteDB;
-
use strict;
}
}
- # 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]));
}
}
}
- # 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}) {
$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 '*') {
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;
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');
# next;
# }
- RouteDB::update($call, $self->{call}, $dxchan ? 1 : undef);
unless ($h) {
if ($parent->via_pc92) {
# 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");
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);
DXXml::Ping::handle_ping_reply($self, $from);
}
} else {
-
- RouteDB::update($from, $self->{call});
-
if (eph_dup($line)) {
return;
}
{
my $parent = shift;
my $s = shift;
+ my $dxchan = shift;
+ my $hops = shift;
+
my ($call, $is_node, $is_extnode, $here, $version, $build) = @$s;
my @rout;
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));
my $slot = shift;
my $parent = shift;
my $t = shift;
+ my $hops = shift;
my $oparent = $parent;
my @radd;
# 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');
}
$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');
$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);
}
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)) {
$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;
$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
# 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;
if ($sort eq 'A') {
for (@nent) {
- push @radd, _add_thingy($parent, $_);
+ push @radd, _add_thingy($parent, $_, $self, $hops);
}
} elsif ($sort eq 'D') {
for (@nent) {
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
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
my $ref = shift;
my $i;
my $out;
-
+
for ($i = 0; $i < @$ref; $i += 2) {
my $r1 = @$ref[$i];
my $r2 = @$ref[$i+1];
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;
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;
-#!/usr/bin/perl
+#
#
# This module impliments the abstracted routing for all protocols and
# is probably what I SHOULD have done the first time.
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;
+ # 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);
+ }
}
}
- 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 = 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);
}
}
- 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
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
+{
+
+}
#
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;
$self->{flags} = shift || Route::here(1);
$self->{users} = [];
$self->{nodes} = [];
- $self->{PC92C_dxchan} = '';
+ $self->{PC92C_dxchan} = {};
$self->reset_obs; # by definition
$list{$call} = $self;
}
}
+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;
+++ /dev/null
-# 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;
$version = '1.55';
$subversion = '0';
-$build = '13';
+$build = '14';
1;
use USDB;
use UDPMsg;
use QSL;
-use RouteDB;
use DXXml;
use DXSql;
use IsoTime;
projects / spider.git / commitdiff