X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FNode.pm;h=e17b01f8858feaf4aee5f965c71bb6bf79fbf48a;hb=refs%2Fremotes%2Forigin%2FSIMPLEROUTE;hp=ee1c9140ca3facb8a5dad741d8c8ace4f3ab1ec8;hpb=bfb3961b8ac7b159ef8155361003bfdd9d26dfad;p=spider.git diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index ee1c9140..e17b01f8 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -4,7 +4,7 @@ # Copyright (c) 2001 Dirk Koopman G1TLH # # $Id$ -# +# package Route::Node; @@ -15,9 +15,6 @@ use DXUtil; use strict; -use vars qw($VERSION $BRANCH); -($VERSION, $BRANCH) = dxver( q$Revision$); - use vars qw(%list %valid @ISA $max $filterdef $obscount); @ISA = qw(Route); @@ -30,7 +27,7 @@ use vars qw(%list %valid @ISA $max $filterdef $obscount); handle_xml => '0,Using XML,yesno', lastmsg => '0,Last Route Msg,atime', lastid => '0,Last Route MsgID', - do_pc92 => '0,Uses pc92,yesno', + do_pc9x => '0,Uses pc9x,yesno', via_pc92 => '0,Came in via pc92,yesno', obscount => '0,Obscount', ); @@ -62,7 +59,7 @@ sub max # object with that callsign. The upper layers are expected to do something # sensible with this! # -# called as $parent->add(call, dxchan, version, flags) +# called as $parent->add(call, dxchan, version, flags) # sub add @@ -98,7 +95,7 @@ sub del $self->_delparent($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}}) { @@ -113,6 +110,21 @@ sub del return @nodes; } +# this deletes this node completely by grabbing the parents +# and deleting me from them +sub delete +{ + my $self = shift; + my @out; + + $self->_del_users; + foreach my $call (@{$self->{parent}}) { + my $parent = Route::Node::get($call); + push @out, $parent->del($self) if $parent; + } + return @out; +} + sub del_nodes { my $parent = shift; @@ -162,7 +174,7 @@ sub del_user my $self = shift; my $ref = shift; my @out; - + if ($ref) { @out = $self->_deluser($ref); $ref->del($self); @@ -213,10 +225,10 @@ sub rnodes return @out; } -# this takes in a list of node and user calls (not references) from +# this takes in a list of node and user calls (not references) from # a config type update for a node and returns # the differences as lists of things that have gone away -# and things that have been added. +# and things that have been added. sub calc_config_changes { my $self = shift; @@ -224,11 +236,25 @@ sub calc_config_changes my %users = map {$_ => 1} @{$self->{users}}; my $cnodes = shift; my $cusers = shift; + if (isdbg('route')) { + dbg("ROUTE: start calc_config_changes"); + dbg("ROUTE: incoming nodes on $self->{call}: " . join(',', sort @$cnodes)); + dbg("ROUTE: incoming users on $self->{call}: " . join(',', sort @$cusers)); + dbg("ROUTE: existing nodes on $self->{call}: " . join(',', sort keys %nodes)); + dbg("ROUTE: existing users on $self->{call}: " . join(',', sort keys %users)); + } my (@dnodes, @dusers, @nnodes, @nusers); push @nnodes, map {my @r = $nodes{$_} ? () : $_; delete $nodes{$_}; @r} @$cnodes; push @dnodes, keys %nodes; push @nusers, map {my @r = $users{$_} ? () : $_; delete $users{$_}; @r} @$cusers; push @dusers, keys %users; + if (isdbg('route')) { + dbg("ROUTE: deleted nodes on $self->{call}: " . join(',', sort @dnodes)); + dbg("ROUTE: deleted users on $self->{call}: " . join(',', sort @dusers)); + dbg("ROUTE: added nodes on $self->{call}: " . join(',', sort @nnodes)); + dbg("ROUTE: added users on $self->{call}: " . join(',', sort @nusers)); + dbg("ROUTE: end calc_config_changes"); + } return (\@dnodes, \@dusers, \@nnodes, \@nusers); } @@ -236,9 +262,9 @@ sub new { my $pkg = shift; my $call = uc shift; - + confess "already have $call in $pkg" if $list{$call}; - + my $self = $pkg->SUPER::new($call); $self->{parent} = ref $pkg ? [ $pkg->{call} ] : [ ]; $self->{version} = shift || 5401; @@ -247,9 +273,9 @@ sub new $self->{nodes} = []; $self->{lastid} = {}; $self->reset_obs; # by definition - + $list{$call} = $self; - + return $self; } @@ -323,7 +349,7 @@ sub DESTROY my $self = shift; my $pkg = ref $self; my $call = $self->{call} || "Unknown"; - + dbg("destroying $pkg with $call") if isdbg('routelow'); } @@ -337,7 +363,7 @@ sub AUTOLOAD my $name = $AUTOLOAD; return if $name =~ /::DESTROY$/; $name =~ s/^.*:://o; - + confess "Non-existant field '$AUTOLOAD'" unless $valid{$name} || $Route::valid{$name}; # this clever line of code creates a subroutine which takes over from autoload