sort working...

diff --git a/cmd/stat/nodeconfig.pl b/cmd/stat/nodeconfig.pl
index 5fa45b9eabc984d9a2eabd0dd7b04e87e45e51a8..ed36bad730ea082fd9de35d0dc04da5c1dfde1bd 100644 (file)
--- a/cmd/stat/nodeconfig.pl
+++ b/cmd/stat/nodeconfig.pl
@@ -15,7 +15,7 @@ foreach my $nref (@nodes) {
        my $ncall = $nref->call;
        next if @list && !grep $ncall =~ m|$_|, @list;
        my $call = $nref->user_call;
-       my $l = join ',', (map {my $ref = Route::Node::get($_); $ref ? ($ref->user_call) : ("$_?")} sort @{$nref->parent});
+       my $l = join ',', (map {my $ref = Route::Node::get($_); $ref ? ($ref->user_call) : ("$_?")} sort @{$nref->links});
        push @out, "$call->$l";
 }
 

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index b0fdd2d9114e49f9338e9a18a999b56ccf4a6ae8..1622728d4749760b59080caf41fc5d5698ed07fc 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -812,7 +812,7 @@ sub handle_16
                                        my @nrout;
                                        for (@$nl) {
                                                $parent = Route::Node::get($_->[0]);
-                                               $dxchan = $parent->dxchan if $parent;
+                                               $dxchan = DXChannel->get($_->[0]) if $parent;
                                                if ($dxchan && $dxchan ne $self) {
                                                        dbg("PCPROT: PC19 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr');
                                                        $parent = undef;
@@ -844,7 +844,7 @@ sub handle_16
                }
        } else {
                                
-               $dxchan = $parent->dxchan;
+               $dxchan = DXChannel->get($parent->call);
                if ($dxchan && $dxchan ne $self) {
                        dbg("PCPROT: PC16 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr');
                        return;
@@ -2081,13 +2081,13 @@ sub send_local_config
                                }
                        }
                } else {
-                       my @rawintcalls = map { $_->nodes } @localnodes if @localnodes;
+                       my @rawintcalls = map { $_->links } @localnodes if @localnodes;
                        my @intcalls;
                        for $node (@rawintcalls) {
                                push @intcalls, $node unless grep $node eq $_, @intcalls; 
                        }
                        my $ref = Route::Node::get($self->{call});
-                       my @rnodes = $ref->nodes;
+                       my @rnodes = $ref->links;
                        for $node (@intcalls) {
                                push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes, @remotenodes;
                        }

diff --git a/perl/Route.pm b/perl/Route.pm
index a9f80fea4e3afe8b1e546c88444fd202467141f8..79208af4789b5c5d610ad001895286ee089219fa 100644 (file)
--- a/perl/Route.pm
+++ b/perl/Route.pm
@@ -27,7 +27,7 @@ $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0))
 $main::build += $VERSION;
 $main::branch += $BRANCH;
 
-use vars qw(%list %valid $filterdef);
+use vars qw(%list %valid $filterdef $default_metric);
 
 %valid = (
                  call => "0,Callsign",
@@ -37,8 +37,11 @@ use vars qw(%list %valid $filterdef);
                  cq => '0,CQ Zone',
                  state => '0,State',
                  city => '0,City',
+                 dxchan => '0,DXChans,parray',
+                 links => '0,Node Links,parray',
                 );
 
+
 $filterdef = bless ([
                          # tag, sort, field, priv, special parser 
                          ['channel', 'c', 0],
@@ -58,6 +61,7 @@ $filterdef = bless ([
                          ['by_state', 'ns', 9],
                         ], 'Filter::Cmd');
 
+$default_metric = 10;
 
 sub new
 {
@@ -170,12 +174,6 @@ sub conf
        return $r ? 1 : 0;
 }
 
-sub parents
-{
-       my $self = shift;
-       return @{$self->{parent}};
-}
-
 # 
 # display routines
 #
@@ -243,7 +241,7 @@ sub config
        }
        
        # deal with more nodes
-       foreach my $ncall (sort @{$self->{nodes}}) {
+       foreach my $ncall (sort @{$self->{links}}) {
                my $nref = Route::Node::get($ncall);
 
                if ($nref) {
@@ -279,34 +277,61 @@ sub get
        return Route::Node::get($call) || Route::User::get($call);
 }
 
+sub _distance
+{
+       my $self = shift;
+       my $ah = shift;
+       my $call = $self->{call};
+       
+       if (DXChannel->get($call)) {
+               my $n = scalar @_ || 0;
+               my $o = $ah->{$call} || 9999;
+               $ah->{$call} = $n if $n < $o;
+               dbg("_distance hit: $call = $n") if isdbg('routech');
+               return;
+       } 
+
+       dbg("_distance miss $call: " . join(',', @_)) if isdbg('routech');
+       
+       foreach my $c (@{$self->{links}}) {
+               next if $c eq $call || $c eq $main::mycall;
+               next if grep $c eq $_, @_;
+               
+               my $n = get($c);
+               _distance($n, $ah, @_, $c);
+       }
+       return;
+}
+
+sub _ordered_routes
+{
+       my $self = shift;
+       my @routes;
+
+       if (exists $self->{dxchan}) {
+               dbg("stored routes for $self->{call}: " . join(',', @{$self->{dxchan}})) if isdbg('routech');
+               return @{$self->{dxchan}} if exists $self->{dxchan};
+       }
+
+       my %ah;
+       _distance($self, \%ah);
+       
+       @routes = sort {$ah{$a} <=> $ah{$b}} keys %ah;
+       $self->{dxchan} = \@routes;
+       dbg("new routes for $self->{call}: " . join(',', @routes)) if isdbg('routech');
+       return @routes;
+}
+
 # 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)) );
+
+       @dxchan = map {DXChannel->get($_)} _ordered_routes($self) unless @dxchan;
        return @dxchan;
 }
 
@@ -334,7 +359,19 @@ sub dxchan
        return $dxchan;
 }
 
+sub _addlink
+{
+       my $self = shift;
+       delete $self->{dxchan};
+    return $self->_addlist('links', @_);
+}
 
+sub _dellink
+{
+       my $self = shift;
+       delete $self->{dxchan};
+    return $self->_dellist('links', @_);
+}
 
 #
 # track destruction

diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm
index 3c4addd01c841ab41d54c45c63e779c0cb734128..d03a75a447e9b1b8d03a3f491b90fa2c6ae74ad5 100644 (file)
--- a/perl/Route/Node.pm
+++ b/perl/Route/Node.pm
@@ -24,8 +24,6 @@ use vars qw(%list %valid @ISA $max $filterdef);
 @ISA = qw(Route);
 
 %valid = (
-                 parent => '0,Parent Calls,parray',
-                 nodes => '0,Nodes,parray',
                  users => '0,Users,parray',
                  usercount => '0,User Count',
                  version => '0,Version',
@@ -69,12 +67,12 @@ sub add
        confess "Route::add trying to add $call to myself" if $call eq $parent->{call};
        my $self = get($call);
        if ($self) {
-               $self->_addparent($parent);
-               $parent->_addnode($self);
+               $self->_addlink($parent);
+               $parent->_addlink($self);
                return undef;
        }
        $self = $parent->new($call, @_);
-       $parent->_addnode($self);
+       $parent->_addlink($self);
        return $self;
 }
 
@@ -91,21 +89,25 @@ sub del
        my $pref = shift;
 
        # delete parent from this call's parent list
-       $pref->_delnode($self);
-    $self->_delparent($pref);
+       $pref->_dellink($self);
+    $self->_dellink($pref);
        my @nodes;
        my $ncall = $self->{call};
        
        # is this the last connection, I have no parents anymore?
-       unless (@{$self->{parent}}) {
-               foreach my $rcall (@{$self->{nodes}}) {
+       unless (@{$self->{links}}) {
+               foreach my $rcall (@{$self->{links}}) {
                        next if grep $rcall eq $_, @_;
                        my $r = Route::Node::get($rcall);
                        push @nodes, $r->del($self, $ncall, @_) if $r;
                }
-               $self->_del_users;
-               delete $list{$self->{call}};
-               push @nodes, $self;
+               if ($ncall ne $main::mycall) {
+                       $self->_del_users;
+                       delete $list{$self->{call}};
+                       push @nodes, $self;
+               } else {
+                       croak "trying to delete route node";
+               }
        }
        return @nodes;
 }
@@ -114,7 +116,9 @@ sub del_nodes
 {
        my $parent = shift;
        my @out;
-       foreach my $rcall (@{$parent->{nodes}}) {
+       foreach my $rcall (@{$parent->{links}}) {
+               next if $rcall eq $parent->{call};
+               next if DXChannel->get($rcall);
                my $r = get($rcall);
                push @out, $r->del($parent, $parent->{call}, @_) if $r;
        }
@@ -185,32 +189,12 @@ sub users
        return @{$self->{users}};
 }
 
-sub nodes
-{
-       my $self = shift;
-       return @{$self->{nodes}};
-}
-
-sub parents
+sub links
 {
        my $self = shift;
-       return @{$self->{parent}};
+       return @{$self->{links}};
 }
 
-sub rnodes
-{
-       my $self = shift;
-       my @out;
-       foreach my $call (@{$self->{nodes}}) {
-               next if grep $call eq $_, @_;
-               push @out, $call;
-               my $r = get($call);
-               push @out, $r->rnodes($call, @_) if $r;
-       }
-       return @out;
-}
-
-
 sub new
 {
        my $pkg = shift;
@@ -219,11 +203,10 @@ sub new
        confess "already have $call in $pkg" if $list{$call};
        
        my $self = $pkg->SUPER::new($call);
-       $self->{parent} = ref $pkg ? [ $pkg->{call} ] : [ ];
+       $self->{links} = ref $pkg ? [ $pkg->{call} ] : [ ];
        $self->{version} = shift;
        $self->{flags} = shift;
        $self->{users} = [];
-       $self->{nodes} = [];
        $self->{lid} = 0;
        
        $list{$call} = $self;
@@ -261,31 +244,6 @@ sub newid
        return 0;
 }
 
-sub _addparent
-{
-       my $self = shift;
-    return $self->_addlist('parent', @_);
-}
-
-sub _delparent
-{
-       my $self = shift;
-    return $self->_dellist('parent', @_);
-}
-
-
-sub _addnode
-{
-       my $self = shift;
-    return $self->_addlist('nodes', @_);
-}
-
-sub _delnode
-{
-       my $self = shift;
-    return $self->_dellist('nodes', @_);
-}
-
 
 sub _adduser
 {

diff --git a/perl/Route/User.pm b/perl/Route/User.pm
index b9862e6de5f0b847a627a4af0279e2043cc85660..df74346236e9372de3739742d15869fdde6bfb36 100644 (file)
--- a/perl/Route/User.pm
+++ b/perl/Route/User.pm
@@ -23,7 +23,7 @@ use vars qw(%list %valid @ISA $max $filterdef);
 @ISA = qw(Route);
 
 %valid = (
-                 parent => '0,Parent Calls,parray',
+                 links => '0,Parent Calls,parray',
 );
 
 $filterdef = $Route::filterdef;
@@ -52,7 +52,7 @@ sub new
        confess "already have $call in $pkg" if $list{$call};
        
        my $self = $pkg->SUPER::new($call);
-       $self->{parent} = [ $ncall ];
+       $self->{links} = [ $ncall ];
        $self->{flags} = $flags;
        $list{$call} = $self;
 
@@ -69,7 +69,7 @@ sub del
        my $self = shift;
        my $pref = shift;
        $self->delparent($pref);
-       unless (@{$self->{parent}}) {
+       unless (@{$self->{links}}) {
                delete $list{$self->{call}};
                return $self;
        }
@@ -87,14 +87,18 @@ sub get
 
 sub addparent
 {
-       my $self = shift;
-    return $self->_addlist('parent', @_);
+       goto &Route::_addlink;
 }
 
 sub delparent
+{
+       goto &Route::_dellink;
+}
+
+sub parents
 {
        my $self = shift;
-    return $self->_dellist('parent', @_);
+       return @{$self->{links}};
 }
 
 #