X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FNode.pm;h=d03a75a447e9b1b8d03a3f491b90fa2c6ae74ad5;hb=aff3103d753ce167d1a056eb982391bd4fcbb5cb;hp=08b74c737295b15006a959e431a0eaa34b19fd42;hpb=3634fba90a64fe488d237f438d9945d81158da52;p=spider.git diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index 08b74c73..d03a75a4 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -16,7 +16,7 @@ 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; +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); $main::build += $VERSION; $main::branch += $BRANCH; @@ -24,11 +24,11 @@ use vars qw(%list %valid @ISA $max $filterdef); @ISA = qw(Route); %valid = ( - parent => '0,Parent Calls,parray', - nodes => '0,Nodes,parray', users => '0,Users,parray', usercount => '0,User Count', version => '0,Version', + np => '0,Using New Prot,yesno', + lid => '0,Last Msgid', ); $filterdef = $Route::filterdef; @@ -67,12 +67,12 @@ sub add confess "Route::add trying to add $call to myself" if $call eq $parent->{call}; my $self = get($call); if ($self) { - $self->_addparent($parent); - $parent->_addnode($self); + $self->_addlink($parent); + $parent->_addlink($self); return undef; } $self = $parent->new($call, @_); - $parent->_addnode($self); + $parent->_addlink($self); return $self; } @@ -89,21 +89,25 @@ sub del my $pref = shift; # delete parent from this call's parent list - $pref->_delnode($self); - my @ref = $self->_delparent($pref); + $pref->_dellink($self); + $self->_dellink($pref); my @nodes; my $ncall = $self->{call}; # is this the last connection, I have no parents anymore? - unless (@ref) { - foreach my $rcall (@{$self->{nodes}}) { + unless (@{$self->{links}}) { + foreach my $rcall (@{$self->{links}}) { next if grep $rcall eq $_, @_; my $r = Route::Node::get($rcall); push @nodes, $r->del($self, $ncall, @_) if $r; } - $self->_del_users; - delete $list{$self->{call}}; - push @nodes, $self; + if ($ncall ne $main::mycall) { + $self->_del_users; + delete $list{$self->{call}}; + push @nodes, $self; + } else { + croak "trying to delete route node"; + } } return @nodes; } @@ -112,7 +116,9 @@ sub del_nodes { my $parent = shift; my @out; - foreach my $rcall (@{$parent->{nodes}}) { + foreach my $rcall (@{$parent->{links}}) { + next if $rcall eq $parent->{call}; + next if DXChannel->get($rcall); my $r = get($rcall); push @out, $r->del($parent, $parent->{call}, @_) if $r; } @@ -183,26 +189,12 @@ sub users return @{$self->{users}}; } -sub nodes +sub links { my $self = shift; - return @{$self->{nodes}}; + return @{$self->{links}}; } -sub rnodes -{ - my $self = shift; - my @out; - foreach my $call (@{$self->{nodes}}) { - next if grep $call eq $_, @_; - push @out, $call; - my $r = get($call); - push @out, $r->rnodes($call, @_) if $r; - } - return @out; -} - - sub new { my $pkg = shift; @@ -211,11 +203,11 @@ sub new confess "already have $call in $pkg" if $list{$call}; my $self = $pkg->SUPER::new($call); - $self->{parent} = ref $pkg ? [ $pkg->{call} ] : [ ]; + $self->{links} = ref $pkg ? [ $pkg->{call} ] : [ ]; $self->{version} = shift; $self->{flags} = shift; $self->{users} = []; - $self->{nodes} = []; + $self->{lid} = 0; $list{$call} = $self; @@ -236,29 +228,20 @@ sub get_all return values %list; } -sub _addparent -{ - my $self = shift; - return $self->_addlist('parent', @_); -} - -sub _delparent +sub newid { my $self = shift; - return $self->_dellist('parent', @_); -} - - -sub _addnode -{ - my $self = shift; - return $self->_addlist('nodes', @_); -} - -sub _delnode -{ - my $self = shift; - return $self->_dellist('nodes', @_); + my $id = shift; + + return 0 if $id == $self->{lid}; + if ($id > $self->{lid}) { + $self->{lid} = $id; + return 1; + } elsif ($self->{lid} - $id > 500) { + $self->{id} = $id; + return 1; + } + return 0; } @@ -290,19 +273,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;