From aff3103d753ce167d1a056eb982391bd4fcbb5cb Mon Sep 17 00:00:00 2001 From: minima Date: Mon, 26 May 2003 21:52:31 +0000 Subject: [PATCH] sort working... --- cmd/stat/nodeconfig.pl | 2 +- perl/DXProt.pm | 8 ++-- perl/Route.pm | 93 +++++++++++++++++++++++++++++------------- perl/Route/Node.pm | 82 +++++++++---------------------------- perl/Route/User.pm | 16 +++++--- 5 files changed, 100 insertions(+), 101 deletions(-) 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}}; } # -- 2.43.0