improve debugging of obscounting

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index f6edc3d58fd4875f07d2bb562feea80a183612ec..835d4424f7a2dbcf80607651bbf0a0d72e6f5c21 100644 (file)
--- 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 b8c31542285b4c9f45c985795b1d3a1076a8e6b3..4a2be35765f854d815ae805a28847ac399d869ed 100644 (file)
--- 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 6e7afa2f3a240031e7df1425c364c7dbbaab4dec..04706cbe980c19ff06defa9b6d2dde88b002e6ea 100644 (file)
--- 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;