X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute.pm;h=521068b023cba2c2e1358140f549d667d8b1d0c9;hb=125670de1ca386c044416d59935cfad9e1759c06;hp=3f940426f4068ffb1e7242de41765eff645b5125;hpb=cc24321cfb0cd5bcb0516ba5587dcf84fed2725e;p=spider.git diff --git a/perl/Route.pm b/perl/Route.pm index 3f940426..521068b0 100644 --- a/perl/Route.pm +++ b/perl/Route.pm @@ -58,6 +58,7 @@ sub new $self->{itu} = $dxcc[1]->itu; $self->{cq} = $dxcc[1]->cq; } + $self->{flags} = here(1); return $self; } @@ -111,14 +112,20 @@ sub _dellist # # flag field constructors/enquirers # +# These can be called in various ways:- +# +# Route::here or $ref->here returns 1 or 0 depending on value of the here flag +# Route::here(1) returns 2 (the bit value of the here flag) +# $ref->here(1) or $ref->here(0) sets the here flag +# sub here { my $self = shift; my $r = shift; return $self ? 2 : 0 unless ref $self; - return ($self->{flags} & 2) ? 1 : 0 unless $r; - $self->{flags} = (($self->{flags} & ~2) | ($r ? 1 : 0)); + return ($self->{flags} & 2) ? 1 : 0 unless defined $r; + $self->{flags} = (($self->{flags} & ~2) | ($r ? 2 : 0)); return $r ? 1 : 0; } @@ -127,7 +134,7 @@ sub conf my $self = shift; my $r = shift; return $self ? 1 : 0 unless ref $self; - return ($self->{flags} & 1) ? 1 : 0 unless $r; + return ($self->{flags} & 1) ? 1 : 0 unless defined $r; $self->{flags} = (($self->{flags} & ~1) | ($r ? 1 : 0)); return $r ? 1 : 0; } @@ -154,6 +161,7 @@ sub config my $self = shift; my $nodes_only = shift; my $level = shift; + my $seen = shift; my @out; my $line; my $call = $self->user_call; @@ -167,6 +175,16 @@ sub config if ($printit) { $line = ' ' x ($level*2) . "$call"; $call = ' ' x length $call; + + # recursion detector + if ((DXChannel->get($self->{call}) && $level > 1) || grep $self->{call} eq $_, @$seen) { + $line .= ' ...'; + push @out, $line; + return @out; + } + push @$seen, $self->{call}; + + # print users unless ($nodes_only) { if (@{$self->{users}}) { $line .= '->'; @@ -193,12 +211,14 @@ sub config push @out, $line if length $line; } + # deal with more nodes foreach my $ncall (sort @{$self->{nodes}}) { my $nref = Route::Node::get($ncall); if ($nref) { my $c = $nref->user_call; - push @out, $nref->config($nodes_only, $level+1, @_); + dbg('routec', "recursing from $call -> $c"); + push @out, $nref->config($nodes_only, $level+1, $seen, @_); } else { push @out, ' ' x (($level+1)*2) . "$ncall?" if @_ == 0 || (@_ && grep $ncall =~ m|$_|, @_); } @@ -232,18 +252,21 @@ sub get sub alldxchan { my $self = shift; - + my @dxchan; my $dxchan = DXChannel->get($self->{call}); - if ($dxchan) { - return (grep $dxchan == $_, @_) ? () : ($dxchan); - } + push @dxchan, $dxchan if $dxchan; # it isn't, build up a list of dxchannels and possible ping times # for all the candidates. - my @dxchan = @_; foreach my $p (@{$self->{parent}}) { - my $ref = $self->get($p); - push @dxchan, $ref->alldxchan(@dxchan) if $ref; + my $dxchan = DXChannel->get($p); + if ($dxchan) { + push @dxchan, $dxchan unless grep $dxchan == $_, @dxchan; + } else { + next if $p eq $main::mycall; # the root + my $ref = $self->get($p); + push @dxchan, $ref->alldxchan if $ref; + } } return @dxchan; } @@ -251,7 +274,9 @@ sub alldxchan sub dxchan { my $self = shift; - my $dxchan; + my $dxchan = DXChannel->get($self->{call}); + return $dxchan if $dxchan; + my @dxchan = $self->alldxchan; return undef unless @dxchan;