add _haslist and has_*

diff --git a/perl/Route.pm b/perl/Route.pm
index 92290d21417d5a3e0a9b56f5ff1c43c1924bfb0d..582434415073033e2ba22aed70c625b2e2c8e3b1 100644 (file)
--- 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 92501266ee24957d88c8b33a503385e0e0ef6709..e7b18772eadeb0bc91fb99066de18ea40161ceb4 100644 (file)
--- 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 ba03b1a962ae504fd6dd7c102da375e401bccc66..86a50c044b7e2c48b61de1fe928fc97e10b8f05f 100644 (file)
--- 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 86c26ea8d487731e740b8d70808089bf4a113c21..685ef0c4d5ef7acaf45e47fa7fc03c2ff3423c43 100644 (file)
--- 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};