X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRoute%2FNode.pm;h=f80e58e324ce5c8e19050d6b03537602fee12777;hb=b9dffeff7239952814342dad19db3a51def6fab7;hp=6a2e2eaabe990ea600bd7ac6453252618d39723d;hpb=2b58ccdf81685a1167a43c38705a0d84b9d8d661;p=spider.git diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index 6a2e2eaa..f80e58e3 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -14,12 +14,6 @@ use Route::User; 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; - use vars qw(%list %valid @ISA $max $filterdef); @ISA = qw(Route); @@ -29,6 +23,9 @@ use vars qw(%list %valid @ISA $max $filterdef); users => '0,Users,parray', usercount => '0,User Count', version => '0,Version', + handle_xml => '0,Using XML,yesno', + lastmsg => '0,Last Route Msg,atime', + lastid => '0,Last Route MsgID', ); $filterdef = $Route::filterdef; @@ -44,6 +41,7 @@ sub count sub max { + count(); return $max; } @@ -66,12 +64,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->{call}); - $parent->_addnode($call); + $self->_addparent($parent); + $parent->_addnode($self); return undef; } - $parent->_addnode($call); $self = $parent->new($call, @_); + $parent->_addnode($self); return $self; } @@ -88,14 +86,13 @@ sub del my $pref = shift; # delete parent from this call's parent list - my $pcall = $pref->{call}; - my $ncall = $self->{call}; - $pref->_delnode($ncall);; - my $ref = $self->_delparent($pcall); + $pref->_delnode($self); + $self->_delparent($pref); my @nodes; + my $ncall = $self->{call}; # is this the last connection, I have no parents anymore? - unless (@$ref) { + unless (@{$self->{parent}}) { foreach my $rcall (@{$self->{nodes}}) { next if grep $rcall eq $_, @_; my $r = Route::Node::get($rcall); @@ -108,6 +105,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; @@ -137,16 +149,17 @@ sub add_user confess "Trying to add NULL User call to routing tables" unless $ucall; - $self->_adduser($ucall); - - $self->{usercount} = scalar @{$self->{users}}; my $uref = Route::User::get($ucall); my @out; if ($uref) { - $uref->addparent($self->{call}); + @out = $uref->addparent($self); } else { - @out = Route::User->new($ucall, $self->{call}, @_); + $uref = Route::User->new($ucall, $self->{call}, @_); + @out = $uref; } + $self->_adduser($uref); + $self->{usercount} = scalar @{$self->{users}}; + return @out; } @@ -154,10 +167,16 @@ sub add_user sub del_user { my $self = shift; - my $ucall = shift; - my $ref = Route::User::get($ucall); - $self->_deluser($ucall); - my @out = $ref->del($self) if $ref; + my $ref = shift; + my @out; + + if ($ref) { + @out = $self->_deluser($ref); + $ref->del($self); + } else { + confess "tried to delete non-existant $ref->{call} from $self->{call}"; + } + $self->{usercount} = scalar @{$self->{users}}; return @out; } @@ -182,6 +201,12 @@ sub nodes return @{$self->{nodes}}; } +sub parents +{ + my $self = shift; + return @{$self->{parent}}; +} + sub rnodes { my $self = shift; @@ -283,19 +308,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;