[libnet-dbus-perl] 83/335: Recursively look for introspection data in parent types

[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 8095c62dcaac0d7000526e3be636c5b641917a70
Author: Daniel P. Berrange <dan at berrange.com>
Date:   Mon Aug 29 12:29:44 2005 +0000

    Recursively look for introspection data in parent types
---
 lib/Net/DBus/Exporter.pm | 28 ++++++++++++++++++++++++++--
 1 file changed, 26 insertions(+), 2 deletions(-)

diff --git a/lib/Net/DBus/Exporter.pm b/lib/Net/DBus/Exporter.pm
index d611784..a54c783 100644
--- a/lib/Net/DBus/Exporter.pm
+++ b/lib/Net/DBus/Exporter.pm
@@ -285,9 +285,33 @@ sub import {
 
 sub dbus_introspector {
     my $object = shift;
+    my $class = shift;
 
-    my $class = ref($object);
-    die "$object must be a blessed reference" unless $class;
+    $class = ref($object) unless $class;
+    die "no introspection data available for '" . 
+	$object->get_object_path . 
+	"' and object is not cast to any interface" unless $class;
+    
+    if (!exists $dbus_exports{$class}) {
+	# If this class has not been exported, lets look
+	# at the parent class & return its introspection
+        # data instead.
+	if (defined (*{"${class}::ISA"})) {
+	    my @isa = @{"${class}::ISA"};
+	    foreach my $parent (@isa) {
+		# We don't recurse to Net::DBus::Object
+		# since we need to give sub-classes the
+		# choice of not supporting introspection
+		next if $parent eq "Net::DBus::Object";
+
+		my $ins = &dbus_introspector($object, $parent);
+		if ($ins) {
+		    return $ins;
+		}
+	    }
+	}
+	return undef;
+    }
 
     unless (exists $dbus_introspectors{$class}) {
 	my $is = Net::DBus::Binding::Introspector->new(object_path => $object->get_object_path);

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