[libnet-dbus-perl] 191/335: Switch to doing Introspect on the virtual components in the object tree hierarchy, starting from /, since dbus takes care of Introspect() for these automatically. Added a method to query children to the Introspector

[Intrigeri]

This is an automated email from the git hooks/post-receive script.

intrigeri pushed a commit to branch experimental
in repository libnet-dbus-perl.

commit 69305dda088b2472a06488242d2f8d9be7068a61
Author: Daniel P. Berrange <berrange at redhat.com>
Date:   Thu Apr 13 11:27:15 2006 -0400

    Switch to doing Introspect on the virtual components in the object tree hierarchy, starting from /, since dbus takes care of Introspect() for these automatically. Added a method to query children to the Introspector
---
 lib/Net/DBus/Binding/Introspector.pm | 13 +++++++++++++
 lib/Net/DBus/Dumper.pm               | 33 ++++++++++++++++++++++++---------
 2 files changed, 37 insertions(+), 9 deletions(-)

diff --git a/lib/Net/DBus/Binding/Introspector.pm b/lib/Net/DBus/Binding/Introspector.pm
index d715d6a..5fbe409 100644
--- a/lib/Net/DBus/Binding/Introspector.pm
+++ b/lib/Net/DBus/Binding/Introspector.pm
@@ -469,6 +469,19 @@ sub list_properties {
     return keys %{$self->{interfaces}->{$interface}->{props}};
 }
 
+
+=item my @paths = $self->list_children;
+
+Returns a list of object paths representing all the children
+of this node.
+
+=cut
+
+sub list_children {
+    my $self = shift;
+    return @{$self->{children}};
+}
+
 =item my $path = $ins->get_object_path
 
 Returns the path of the object associated with this introspection
diff --git a/lib/Net/DBus/Dumper.pm b/lib/Net/DBus/Dumper.pm
index 8833b83..c6359ba 100644
--- a/lib/Net/DBus/Dumper.pm
+++ b/lib/Net/DBus/Dumper.pm
@@ -164,19 +164,34 @@ sub _dbus_dump_service {
     
     my @data;
     push @data, "Service: ", $service->get_service_name, "\n";
+    
+    my @objects = &_dbus_dump_children($service, "/");
+    foreach (@objects) {
+	push @data, "  Object: $_\n";
+    }
+    return @data;
+}
 
-    my $exp = $service->get_object("/org/cpan/Net/DBus/Exporter");
-    my $exports = eval {
-	$exp->ListObjects();
+sub _dbus_dump_children {
+    my $service = shift;
+    my $path = shift;
+
+    my $exp = $service->get_object($path);
+    my @exports = eval {
+	my $ins = $exp->_introspector;
+        if ($ins) {
+	    return $ins->list_children;
+        }
+	return ();
     };
+    my @objects = map { $path eq "/" ? $path . $_ : $path . "/" . $_ } @exports;
     if ($@) {
-	push @data, "  Could not lookup list of exported object\n";
-    } else {
-	foreach (@{$exports}) {
-	    push @data, "  Object: $_\n";
-	}
+	#push @objects, " Could not lookup objects under path '$path'\n";
     }
-    return @data;
+    foreach my $child (@exports) {
+	push @objects, _dbus_dump_children ($service, $path eq "/" ? $path . $child : $path . "/" . $child);
+    }
+    return @objects;
 }
 
 sub _dbus_dump_bus {

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libnet-dbus-perl.git