From: minima Date: Thu, 24 Feb 2005 23:05:39 +0000 (+0000) Subject: add _haslist and has_* X-Git-Tag: R_1_52~130 X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=4461c555c086c35adc0f458ffbe3e6a03cfc68a1;p=spider.git add _haslist and has_* --- diff --git a/perl/Route.pm b/perl/Route.pm index 92290d21..58243441 100644 --- a/perl/Route.pm +++ b/perl/Route.pm @@ -130,6 +130,16 @@ sub _dellist return @out; } +sub _haslist +{ + my $self = shift; + my $field = shift; + my @out; + my $call = shift; + my $r = grep $_->{call} eq $call, @{$self->{$field}}; + dbg(ref($self) . " $call is " . $r?'in':'NOT in' . " $self->{call}\->\{$field\}") if isdbg('routelow'); +} + sub is_empty { my $self = shift; diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index 92501266..e7b18772 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -204,6 +204,25 @@ sub parents return @{$self->{parent}}; } +sub has_user +{ + my $self = shift; + return $self->_haslist('users', shift); +} + +sub has_node +{ + my $self = shift; + return $self->_haslist('nodes', shift); +} + +sub has_parent +{ + my $self = shift; + return $self->_haslist('parent', shift); +} + + sub rnodes { my $self = shift; diff --git a/perl/Route/User.pm b/perl/Route/User.pm index ba03b1a9..86a50c04 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -86,13 +86,19 @@ sub get sub addparent { my $self = shift; - return $self->_addlist('parent', @_); + return $self->_addlist('parent', shift); } sub delparent { my $self = shift; - return $self->_dellist('parent', @_); + return $self->_dellist('parent', shift); +} + +sub has_parent +{ + my $self = shift; + return $self->_haslist('parent', shift); } # diff --git a/perl/Thingy/Rt.pm b/perl/Thingy/Rt.pm index 86c26ea8..685ef0c4 100644 --- a/perl/Thingy/Rt.pm +++ b/perl/Thingy/Rt.pm @@ -84,16 +84,17 @@ sub handle_cf my $origin = $thing->{origin}; my $chan_call = $dxchan->{call}; + my @pc19; + my @pc21; + my $parent = Route::Node::get($origin); unless ($parent) { - dbg("Thingy::Rt::cf: received from $origin on $chan_call unknown") if isdbg('chanerr'); - return; + dbg("Thingy::Rt::cf: new (unconnected) node $origin arrived") if isdbg('chanerr'); + $parent = Route::Node::new($origin, 0, 1); + push @pc19, $parent; } $parent->np(1); - my @pc19; - my @pc21; - # move the origin over to the user, if required if ($thing->{user}) { $origin = $thing->{user};