From c62d1dbdc3238711628d49608946eefedda2362e Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Sun, 24 Jun 2007 10:44:48 +0100 Subject: [PATCH] improve debugging of obscounting --- perl/DXProt.pm | 47 ++++++++++++++++++++++++++++++++++---------- perl/DXProtHandle.pm | 8 +++----- perl/Version.pm | 2 +- 3 files changed, 41 insertions(+), 16 deletions(-) diff --git a/perl/DXProt.pm b/perl/DXProt.pm index f6edc3d5..835d4424 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -885,19 +885,19 @@ sub time_out_pc92_routes my $o = $n->dec_obs; if ($o <= 0) { if (my $dxchan = DXChannel::get($n->call)) { - dbg("disconnecting local pc92 $dxchan->{call} on obscount"); + dbg("disconnecting local pc92 $dxchan->{call} on obscount") if isdbg('obscount'); $dxchan->disconnect; next; } my @parents = map {Route::Node::get($_)} $n->parents; for (@parents) { if ($_) { - dbg("deleting pc92 $_->{call} from $n->{call} on obscount"); + dbg("deleting pc92 $_->{call} from $n->{call} on obscount") if isdbg('obscount'); push @rdel, $n->del($_); } } } else { - dbg("ROUTE: obscount on $n->{call} now $o") if isdbg('route'); + dbg("ROUTE: obscount on $n->{call} now $o") if isdbg('obscount'); } } for (@rdel) { @@ -1223,6 +1223,7 @@ sub send_route } } +# broadcast everywhere sub broadcast_route { my $self = shift; @@ -1238,8 +1239,33 @@ sub broadcast_route } unless ($self->{isolate}) { foreach $dxchan (@dxchan) { - next if $dxchan == $self; - next if $dxchan == $main::me; + next if $dxchan == $self || $dxchan == $main::me; + next if $origin eq $dxchan->{call}; # don't route some from this call back again. + next unless $dxchan->isa('DXProt'); + + $dxchan->send_route($origin, $generate, @_); + } + } +} + +# broadcast to non-pc9x nodes +sub broadcast_route_nopc9x +{ + my $self = shift; + my $origin = shift; + my $generate = shift; + my $line = shift; + my @dxchan = DXChannel::get_all_nodes(); + my $dxchan; + + if ($line) { + $line =~ /\^H(\d+)\^?\~?$/; + return unless $1 > 0; + } + unless ($self->{isolate}) { + foreach $dxchan (@dxchan) { + next if $dxchan == $self || $dxchan == $main::me; + next if $origin eq $dxchan->{call}; # don't route some from this call back again. next unless $dxchan->isa('DXProt'); next if $dxchan->{do_pc9x}; next if ($generate == \&pc16 || $generate==\&pc17) && !$dxchan->user->wantsendpc16; @@ -1265,6 +1291,7 @@ sub send_route_pc92 $self->send($line); } +# broadcast only to pc9x nodes sub broadcast_route_pc9x { my $self = shift; @@ -1284,8 +1311,8 @@ sub broadcast_route_pc9x foreach $dxchan (@dxchan) { next if $dxchan == $self || $dxchan == $main::me; next if $origin eq $dxchan->{call}; # don't route some from this call back again. - next unless $dxchan->{do_pc9x}; next unless $dxchan->isa('DXProt'); + next unless $dxchan->{do_pc9x}; $dxchan->send($line); } @@ -1298,7 +1325,7 @@ sub route_pc16 return unless $self->user->wantpc16; my $origin = shift; my $line = shift; - broadcast_route($self, $origin, \&pc16, $line, 1, @_); + broadcast_route_nopc9x($self, $origin, \&pc16, $line, 1, @_); } sub route_pc17 @@ -1307,7 +1334,7 @@ sub route_pc17 return unless $self->user->wantpc16; my $origin = shift; my $line = shift; - broadcast_route($self, $origin, \&pc17, $line, 1, @_); + broadcast_route_nopc9x($self, $origin, \&pc17, $line, 1, @_); } sub route_pc19 @@ -1315,7 +1342,7 @@ sub route_pc19 my $self = shift; my $origin = shift; my $line = shift; - broadcast_route($self, $origin, \&pc19, $line, scalar @_, @_); + broadcast_route_nopc9x($self, $origin, \&pc19, $line, scalar @_, @_); } sub route_pc21 @@ -1323,7 +1350,7 @@ sub route_pc21 my $self = shift; my $origin = shift; my $line = shift; - broadcast_route($self, $origin, \&pc21, $line, scalar @_, @_); + broadcast_route_nopc9x($self, $origin, \&pc21, $line, scalar @_, @_); } sub route_pc24 diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm index b8c31542..4a2be357 100644 --- a/perl/DXProtHandle.pm +++ b/perl/DXProtHandle.pm @@ -1594,10 +1594,10 @@ sub handle_92 # we only reset obscounts on config records $oparent->reset_obs; - dbg("ROUTE: reset obscount on $pcall now " . $oparent->obscount) if isdbg('route'); + dbg("ROUTE: reset obscount on $pcall now " . $oparent->obscount) if isdbg('obscount'); if ($oparent != $parent) { $parent->reset_obs; - dbg("ROUTE: reset obscount on $parent->{call} now " . $parent->obscount) if isdbg('route'); + dbg("ROUTE: reset obscount on $parent->{call} now " . $parent->obscount) if isdbg('obscount'); } # @@ -1759,9 +1759,7 @@ sub handle_default my $line = shift; my $origin = shift; - if (eph_dup($line)) { - dbg("PCPROT: Ephemeral dup, dropped") if isdbg('chanerr'); - } else { + unless (eph_dup($line)) { if ($pcno >= 90) { my $pcall = $_[1]; unless (is_callsign($pcall)) { diff --git a/perl/Version.pm b/perl/Version.pm index 6e7afa2f..04706cbe 100644 --- a/perl/Version.pm +++ b/perl/Version.pm @@ -11,6 +11,6 @@ use vars qw($version $subversion $build); $version = '1.54'; $subversion = '0'; -$build = '83'; +$build = '84'; 1; -- 2.43.0