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 <d...@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

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits

Reply via email to