X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FNode.pm;h=d2105f8f6b6bcf57aea77391344f243c7af3681e;hb=fb9c2ab04977b4e685b0eca3b2a2d04a77f65f4b;hp=00e410713354bfde7db1f7a909144a86be0ca070;hpb=314a26e98d3c3e6a717a9f66ead3ed91cce09ea5;p=spider.git diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index 00e41071..d2105f8f 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -3,8 +3,8 @@ # # 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); @@ -27,12 +24,15 @@ use vars qw(%list %valid @ISA $max $filterdef $obscount); users => '0,Users,parray', usercount => '0,User Count', version => '0,Version', + build => '0,Build', 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', + last_PC92C => '9,Last PC92C', + PC92C_dxchan => '9,Channel of PC92C', ); $filterdef = $Route::filterdef; @@ -62,7 +62,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 +98,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}}) { @@ -107,12 +107,39 @@ sub del push @nodes, $r->del($self, $ncall, @_) if $r; } $self->_del_users; - delete $list{$self->{call}}; + delete $list{$ncall}; push @nodes, $self; } return @nodes; } +# this deletes this node completely by grabbing the parents +# and deleting me from them, then deleting me from all the +# dependent nodes. +sub delete +{ + my $self = shift; + my @out; + my $ncall = $self->{call}; + + # get rid of users and parents + $self->_del_users; + if (@{$self->{parent}}) { + foreach my $call (@{$self->{parent}}) { + my $parent = Route::Node::get($call); + push @out, $parent->del($self) if $parent; + } + } + # get rid of my nodes + push @out, $self->del_nodes; + # this only happens if we a orphan with no parents + if ($list{$ncall}) { + push @out, $self; + delete $list{$ncall}; + } + return @out; +} + sub del_nodes { my $parent = shift; @@ -162,7 +189,7 @@ sub del_user my $self = shift; my $ref = shift; my @out; - + if ($ref) { @out = $self->_deluser($ref); $ref->del($self); @@ -213,10 +240,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 +251,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 +277,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; @@ -246,9 +287,11 @@ sub new $self->{users} = []; $self->{nodes} = []; $self->{lastid} = {}; - + $self->{PC92C_dxchan} = ''; + $self->reset_obs; # by definition + $list{$call} = $self; - + return $self; } @@ -308,6 +351,7 @@ sub dec_obs { my $self = shift; $self->{obscount}--; + return $self->{obscount}; } sub reset_obs @@ -321,7 +365,7 @@ sub DESTROY my $self = shift; my $pkg = ref $self; my $call = $self->{call} || "Unknown"; - + dbg("destroying $pkg with $call") if isdbg('routelow'); } @@ -335,7 +379,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