X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FNode.pm;h=76d987572e3e789f6beee90ba9a0ed0bfcddbcf3;hb=4b207544da78b182bd12e94eab01451694749012;hp=d3b1e955411833567a8b2551c55e19d1616b4136;hpb=af378e74088394d9c70a9a01d67a311cf4774d96;p=spider.git diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index d3b1e955..76d98757 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -3,40 +3,41 @@ # # Copyright (c) 2001 Dirk Koopman G1TLH # -# $Id$ -# +# +# package Route::Node; use DXDebug; use Route; use Route::User; +use DXUtil; use strict; -use vars qw($VERSION $BRANCH); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; - -use vars qw(%list %valid @ISA $max $filterdef); +use vars qw(%list %valid @ISA $max $filterdef $obscount); @ISA = qw(Route); %valid = ( - parent => '0,Parent Calls,parray', nodes => '0,Nodes,parray', 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_pc9x => '0,Uses pc9x,yesno', + via_pc92 => '0,In via pc92?,yesno', + obscount => '0,Obscount', + last_PC92C => '9,Last PC92C', + PC92C_dxchan => '9,PC92C hops,phash', ); $filterdef = $Route::filterdef; %list = (); $max = 0; +$obscount = 3; sub count { @@ -60,7 +61,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 @@ -76,6 +77,7 @@ sub add } $self = $parent->new($call, @_); $parent->_addnode($self); + dbg("CLUSTER: node $call added") if isdbg('cluster'); return $self; } @@ -96,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}}) { @@ -105,12 +107,40 @@ sub del push @nodes, $r->del($self, $ncall, @_) if $r; } $self->_del_users; - delete $list{$self->{call}}; + delete $list{$ncall}; push @nodes, $self; + dbg("CLUSTER: node $ncall deleted") if isdbg('cluster'); } 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; @@ -137,6 +167,8 @@ sub add_user { my $self = shift; my $ucall = shift; + my $here = shift; + my $ip = shift; confess "Trying to add NULL User call to routing tables" unless $ucall; @@ -145,7 +177,7 @@ sub add_user if ($uref) { @out = $uref->addparent($self); } else { - $uref = Route::User->new($ucall, $self->{call}, @_); + $uref = Route::User->new($ucall, $self->{call}, $here, $ip); @out = $uref; } $self->_adduser($uref); @@ -160,7 +192,7 @@ sub del_user my $self = shift; my $ref = shift; my @out; - + if ($ref) { @out = $self->_deluser($ref); $ref->del($self); @@ -171,6 +203,14 @@ sub del_user return @out; } +# is a user on this node +sub is_user +{ + my $self = shift; + my $call = shift; + return scalar grep {$_ eq $call} @{$self->{users}}; +} + sub usercount { my $self = shift; @@ -192,12 +232,6 @@ sub nodes return @{$self->{nodes}}; } -sub parents -{ - my $self = shift; - return @{$self->{parent}}; -} - sub rnodes { my $self = shift; @@ -211,23 +245,60 @@ sub rnodes return @out; } +# 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. +sub calc_config_changes +{ + my $self = shift; + my %nodes = map {$_ => 1} @{$self->{nodes}}; + 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); +} + 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; - $self->{flags} = shift; + $self->{version} = shift || 5401; + $self->{flags} = shift || Route::here(1); $self->{users} = []; $self->{nodes} = []; - + $self->{PC92C_dxchan} = {}; + my $ip = shift; + $self->{ip} = $ip if defined $ip; + $self->reset_obs; # by definition + $list{$call} = $self; - + return $self; } @@ -236,7 +307,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; } @@ -283,13 +354,51 @@ sub _deluser return $self->_dellist('users', @_); } +sub dec_obs +{ + my $self = shift; + $self->{obscount}--; + return $self->{obscount}; +} + +sub reset_obs +{ + my $self = shift; + $self->{obscount} = $obscount; +} + +sub measure_pc9x_t +{ + my $parent = shift; + my $t = shift; + my $lastid = $parent->{lastid}; + if ($lastid) { + return ($t < $lastid) ? $t+86400-$lastid : $t - $lastid; + } else { + return 86400; + } +} + +sub PC92C_dxchan +{ + my $parent = shift; + my $call = shift; + my $hops = shift; + if ($call && $hops) { + $hops =~ s/^H//; + $parent->{PC92C_dxchan}->{$call} = $hops; + return; + } + return (%{$parent->{PC92C_dxchan}}); +} + sub DESTROY { my $self = shift; 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'); } # @@ -302,7 +411,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