allow debug to track cluster config

This is for Jim AD1C really. But "set/debug cluster" will put out
lines like:

CLUSTER: node N0VD-7 added
CLUSTER: user AD6KH added
and
CLUSTER: user AD6KH deleted
CLUSTER: node N0VD-7 deleted

and represent this node's view of which nodes and users are
available on the cluster as a whole.

diff --git a/Changes b/Changes
index 0ab94e0620b70f6b9564ae3ea319171c23eb16d2..883f35e522ca96a675b0df6f135f952ca41d41dc 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,6 @@
+29Oct10=======================================================================
+1. Allow Jim AD1C to track the changes to the cluster in realtime using the
+debug system (set/debug cluster).
 27Oct10=======================================================================
 1. fix chat problem introduced in the last update
 25Oct10=======================================================================

diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm
index 213e9b4008053d0d7eeb2efdfb1838f2f3c7730e..14e7766de48c8a675330d4c75007434b517eede3 100644 (file)
--- a/perl/DXProtHandle.pm
+++ b/perl/DXProtHandle.pm
@@ -1993,8 +1993,8 @@ sub handle_93
                $self->send_announce(1, pc12($from, $text, $local, $sysop, $wx, $pcall), $from, $local, $text, $sysop, $pcall, $wx, $via eq 'LOCAL' ? $via : undef);
                return if $via eq 'LOCAL';
        } elsif (!is_callsign($to) && $text =~ /^#\d+ /) {
-               # chat messages to non-pc9x nodes
-               $self->send_chat(1, pc12($from, $text, undef, $to, undef, $pcall), $from, '*', $text, $to, $pcall, '0');
+               # chat messages really only locally connected users
+               $self->send_chat(1, $line, $from, '*', $text, $to, $pcall, '0');
        }
 
        # broadcast this chat sentence everywhere unless it is targetted to 'LOCAL'

diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm
index 617a0aed43a0718c47cebaf5ea28413d95165a39..89e84d4072b1910b83b6b41d05c2d50431df2b4e 100644 (file)
--- a/perl/Route/Node.pm
+++ b/perl/Route/Node.pm
@@ -79,6 +79,7 @@ sub add
        }
        $self = $parent->new($call, @_);
        $parent->_addnode($self);
+       dbg("CLUSTER: node $call added") if isdbg('cluster');
        return $self;
 }
 
@@ -110,6 +111,7 @@ sub del
                $self->_del_users;
                delete $list{$ncall};
                push @nodes, $self;
+               dbg("CLUSTER: node $ncall deleted") if isdbg('cluster');
        }
        return @nodes;
 }
@@ -298,7 +300,7 @@ sub get
        my $call = shift;
        $call = shift if ref $call;
        my $ref = $list{uc $call};
-       dbg("Failed to get Node $call" ) if !$ref && isdbg('routerr');
+       dbg("ROUTE: Failed to get Node $call" ) if !$ref && isdbg('routerr');
        return $ref;
 }
 
@@ -389,7 +391,7 @@ sub DESTROY
        my $pkg = ref $self;
        my $call = $self->{call} || "Unknown";
 
-       dbg("destroying $pkg with $call") if isdbg('routelow');
+       dbg("ROUTE: destroying $pkg with $call") if isdbg('routelow');
 }
 
 #

diff --git a/perl/Route/User.pm b/perl/Route/User.pm
index de24f906ef7155059c112743d8b5024e75a0b98b..0cd170299f482243af45b801d767376d48d6bdda 100644 (file)
--- a/perl/Route/User.pm
+++ b/perl/Route/User.pm
@@ -54,6 +54,7 @@ sub new
        $self->{flags} = $flags || Route::here(1);
        $self->{ip} = $ip if defined $ip;
        $list{$call} = $self;
+       dbg("CLUSTER: user $call added") if isdbg('cluster');
 
        return $self;
 }
@@ -67,9 +68,11 @@ sub del
 {
        my $self = shift;
        my $pref = shift;
+       my $call = $self->{call};
        $self->delparent($pref);
        unless (@{$self->{parent}}) {
-               delete $list{$self->{call}};
+               delete $list{$call};
+               dbg("CLUSTER: user $call deleted") if isdbg('cluster');
                return $self;
        }
        return undef;

diff --git a/perl/Version.pm b/perl/Version.pm
index 7da8dbd07d37ca8ed9fb3a0f980978dd733e50c4..1d6f99afe9649941dc52fde3196c321619e5a969 100644 (file)
--- a/perl/Version.pm
+++ b/perl/Version.pm
@@ -11,7 +11,7 @@ use vars qw($version $subversion $build $gitversion);
 
 $version = '1.55';
 $subversion = '0';
-$build = '80';
-$gitversion = 'fc55b5f';
+$build = '81';
+$gitversion = '67e8ed5';
 
 1;