X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FNode.pm;h=d27efbf8a1d62e52ded6081669ea05d035dced01;hb=cbda6153fad2adddb58ee5a87f3981aa2ad754ad;hp=e7a6f8e4e1c352bbdb563d10bd05a21a59c851dd;hpb=9a61ef555083e7288a41de95d3709454c0a20625;p=spider.git diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index e7a6f8e4..d27efbf8 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -11,16 +11,14 @@ 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; -$main::build += $VERSION; -$main::branch += $BRANCH; +($VERSION, $BRANCH) = dxver( q$Revision$); -use vars qw(%list %valid @ISA $max $filterdef); +use vars qw(%list %valid @ISA $max $filterdef $obscount); @ISA = qw(Route); %valid = ( @@ -29,13 +27,18 @@ use vars qw(%list %valid @ISA $max $filterdef); users => '0,Users,parray', usercount => '0,User Count', version => '0,Version', - pc90 => '0,Using PC90,yesno', - lastpc90 => '0,Last PC90 time,cldatetime', + 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,Came in via pc92,yesno', + obscount => '0,Obscount', ); $filterdef = $Route::filterdef; %list = (); $max = 0; +$obscount = 3; sub count { @@ -110,6 +113,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; @@ -210,6 +228,38 @@ 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 { @@ -220,10 +270,12 @@ sub new 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->{lastid} = {}; + $self->reset_obs; # by definition $list{$call} = $self; @@ -282,6 +334,19 @@ 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 DESTROY { my $self = shift; @@ -298,19 +363,16 @@ sub DESTROY sub AUTOLOAD { no strict; - - my $self = shift; - $name = $AUTOLOAD; + my $name = $AUTOLOAD; return if $name =~ /::DESTROY$/; - $name =~ s/.*:://o; + $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 # from OO Perl - Conway -# print "AUTOLOAD: $AUTOLOAD\n"; -# *{$AUTOLOAD} = sub {my $self = shift; @_ ? $self->{$name} = shift : $self->{$name}} ; - @_ ? $self->{$name} = shift : $self->{$name} ; + *$AUTOLOAD = sub {$_[0]->{$name} = $_[1] if @_ > 1; return $_[0]->{$name}}; + goto &$AUTOLOAD; } 1;