[libnet-dbus-perl] 66/335: Added module for dumping info about DBus objects

[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 2b2e95b30b9e7dbc45cf48a0f160317da0ffd981
Author: Daniel P. Berrange <dan at berrange.com>
Date:   Sun Aug 14 18:06:56 2005 +0000

    Added module for dumping info about DBus objects
---
 lib/Net/DBus/Dumper.pm | 71 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 71 insertions(+)

diff --git a/lib/Net/DBus/Dumper.pm b/lib/Net/DBus/Dumper.pm
new file mode 100644
index 0000000..7d95e28
--- /dev/null
+++ b/lib/Net/DBus/Dumper.pm
@@ -0,0 +1,71 @@
+package Net::DBus::Dumper;
+
+use strict;
+use warnings;
+
+use Exporter;
+
+use vars qw(@EXPORT);
+
+ at EXPORT = qw(dbus_dump);
+
+sub dbus_dump {
+    my $object = shift;
+    
+    my $ref = ref($object);
+    die "object '$object' is not a reference" unless defined $ref;
+    
+    if ($object->isa("Net::DBus::Object") ||
+	$object->isa("Net::DBus::RemoteObject")) {
+	return &_dbus_dump_introspector($object->_introspector);
+    } elsif ($object->isa("Net::DBus::RemoteService")) {
+	return &_dbus_dump_remote_service($object);
+    } elsif ($object->isa("Net::DBus::Service")) {
+	return &_dbus_dump_service($object);
+    } elsif ($object->isa("Net::DBus")) {
+	return &_dbus_dump_bus($object);
+    }
+}
+
+
+sub _dbus_dump_introspector {
+    my $ins = shift;
+    
+    my @data;
+    push @data, "Object: ", $ins->get_object_path, "\n";
+    foreach my $interface ($ins->list_interfaces) {
+	push @data, "  Interface: ", $interface, "\n";
+	foreach my $method ($ins->list_methods($interface)) {
+	    push @data, "    Method: ", $method, "\n";
+	    foreach my $param ($ins->get_method_params($interface, $method)) {
+		push @data, &_dbus_dump_types("      > ", $param);
+	    }
+	    foreach my $param ($ins->get_method_returns($interface, $method)) {
+		push @data, &_dbus_dump_types("      < ", $param);
+	    }
+	}
+	foreach my $signal ($ins->list_signals($interface)) {
+	    push @data, "    Signal: ", $signal, "\n";
+	    foreach my $param ($ins->get_signal_params($interface, $signal)) {
+		push @data, &_dbus_dump_types("      > ", $param);
+	    }
+	}
+    }
+    return @data;
+}
+
+sub _dbus_dump_types {
+    my $indent = shift;
+    my $type = shift;
+    
+    my @data;
+    if (ref($type)) {
+	push @data, $indent, $type->[0], "\n";
+	for (my $i = 1 ; $i <= $#{$type} ; $i++) {
+	    push @data, &_dbus_dump_types($indent . "  ", $type->[$i]);
+	}
+    } else {
+	push @data, $indent, $type, "\n";
+    }
+    return @data;
+}

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