[libnet-dbus-perl] 75/335: Added support for services & buses. Added POD docs

[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 6c671f50b8eede2512f86f2907ed09a1e4340095
Author: Daniel P. Berrange <dan at berrange.com>
Date:   Mon Aug 22 12:30:15 2005 +0000

    Added support for services & buses. Added POD docs
---
 lib/Net/DBus/Dumper.pm | 121 +++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 118 insertions(+), 3 deletions(-)

diff --git a/lib/Net/DBus/Dumper.pm b/lib/Net/DBus/Dumper.pm
index 7d95e28..6318f73 100644
--- a/lib/Net/DBus/Dumper.pm
+++ b/lib/Net/DBus/Dumper.pm
@@ -1,3 +1,59 @@
+=pod
+
+=head1 NAME
+
+Net::DBus::Dumper - stringify DBus objects suitable for printing
+
+=head1 SYNOPSIS
+
+  use Net::DBus::Dumper;
+
+  use Net::DBus;
+
+  # Dump out info about the bus
+  my $bus = Net::DBus->find;
+  print dbus_dump($bus);
+
+  # Dump out info about a service
+  my $service = $bus->get_service("org.freedesktop.DBus");
+  print dbus_dump($service);
+
+  # Dump out info about an object
+  my $object = $service->get_object("/org/freedesktop/DBus");
+  print dbus_dump($object);
+
+=head1 DESCRIPTION
+
+This module serves as a debugging aid, providing a means to stringify
+a DBus related object in a form suitable for printing out. It can 
+stringify any of the Net::DBus:* objects, generating the following
+information for each
+
+=over 4
+
+=item Net::DBus
+
+A list of services registered with the bus
+
+=item Net::DBus::Service
+=item Net::DBus::RemoteService
+
+The service name
+
+=item Net::DBus::Object
+=item Net::DBus::RemoteObject
+
+The list of all exported methods, and signals, along with their
+parameter and return types.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
 package Net::DBus::Dumper;
 
 use strict;
@@ -9,6 +65,20 @@ use vars qw(@EXPORT);
 
 @EXPORT = qw(dbus_dump);
 
+=pod
+
+=item my @data = dbus_dump($object);
+
+Generates a stringified representation of an object. The object
+passed in as the parameter must be an instance of one of L<Net::DBus>, 
+L<Net::DBus::RemoteService>, L<Net::DBus::Service>,
+L<Net::DBus::RemoteObject>, L<Net::DBus::Object>. The stringified
+representation will be returned as a list of strings, with newlines
+in appropriate places, such that it can be passed string to the C<print>
+method.
+
+=cut
+
 sub dbus_dump {
     my $object = shift;
     
@@ -18,9 +88,8 @@ sub dbus_dump {
     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")) {
+    } elsif ($object->isa("Net::DBus::RemoteService") ||
+	     $object->isa("Net::DBus::Service")) {
 	return &_dbus_dump_service($object);
     } elsif ($object->isa("Net::DBus")) {
 	return &_dbus_dump_bus($object);
@@ -69,3 +138,49 @@ sub _dbus_dump_types {
     }
     return @data;
 }
+
+
+sub _dbus_dump_service {
+    my $service = shift;
+    
+    my @data;
+    push @data, "Service: ", $service->get_service_name, "\n";
+    # XXX is there some way to get a list of registered object
+    # paths from the bus ?!?!?!
+    return @data;
+}
+
+sub _dbus_dump_bus {
+    my $bus = shift;
+    
+    my @data;
+    push @data, "Bus: \n";
+    
+    
+    my $dbus = $bus->get_service("org.freedesktop.DBus");
+    my $obj = $dbus->get_object("/org/freedesktop/DBus");
+    my $names = $obj->ListNames();
+    
+    foreach (sort { $a cmp $b } @{$names}) {
+	push @data, "  Service: ", $_, "\n";
+    }
+    return @data;
+}
+
+=pod
+
+=head1 BUGS
+
+It should print out a list of object paths registered against a
+service
+
+=head1 SEE ALSO
+
+L<Net::DBus>, L<Net::DBus::RemoteService>, L<Net::DBus::Service>, 
+L<Net::DBus::RemoteObject>, L<Net::DBus::Object>, L<Data::Dumper>.
+
+=head1 COPYRIGHT
+
+Copyright 2005 Daniel Berrange <dan at berrange.com>
+
+=cut

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