From: minima <minima>
Date: Mon, 26 May 2003 21:52:31 +0000 (+0000)
Subject: sort working...
X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=aff3103d753ce167d1a056eb982391bd4fcbb5cb;p=spider.git

sort working...
---

diff --git a/cmd/stat/nodeconfig.pl b/cmd/stat/nodeconfig.pl
index 5fa45b9e..ed36bad7 100644
--- 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 b0fdd2d9..1622728d 100644
--- 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 a9f80fea..79208af4 100644
--- 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 3c4addd0..d03a75a4 100644
--- 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 b9862e6d..df743462 100644
--- 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}};
 }
 
 #