[libnet-dbus-perl] 75/335: Added support for services & buses. Added POD docs
Intrigeri
intrigeri at moszumanska.debian.org
Sat Mar 21 01:07:27 UTC 2015
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
More information about the Pkg-perl-cvs-commits
mailing list