[libnet-dbus-perl] 74/335: Added POD docs, and tweaked heuristics for find method
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 c5e9eff8263ec23d62aec1a7e95660e1763b84b5
Author: Daniel P. Berrange <dan at berrange.com>
Date: Mon Aug 22 12:30:00 2005 +0000
Added POD docs, and tweaked heuristics for find method
---
lib/Net/DBus.pm | 235 ++++++++++++++++++++++++++++++++++++++++++++++++--------
1 file changed, 204 insertions(+), 31 deletions(-)
diff --git a/lib/Net/DBus.pm b/lib/Net/DBus.pm
index 3355f9d..89ba61e 100644
--- a/lib/Net/DBus.pm
+++ b/lib/Net/DBus.pm
@@ -1,3 +1,65 @@
+=head1 NAME
+
+DBus - Perl extension for the DBus message system
+
+=head1 SYNOPSIS
+
+
+ ####### Attaching to the bus ###########
+
+ use Net::DBus;
+
+ # Find the most appropriate bus
+ my $bus = Net::DBus->find;
+
+ # ... or explicitly go for the session bus
+ my $bus = Net::DBus->session;
+
+ # .... or explicitly go for the system bus
+ my $bus = Net::DBus->system
+
+
+ ######## Accessing remote services #########
+
+ # Get the service known by 'org.freedesktop.DBus'
+ my $service = $bus->get_service("org.freedesktop.DBus");
+
+ # See if SkyPE is around
+ if ($bus->has_service("com.skype.API")) {
+ my $skype = $bus->get_service("com.skype.API");
+ ... do stuff with skype ...
+ } else {
+ print STDERR "SkyPE does not appear to be running\n";
+ exit 1
+ }
+
+
+ ######### Providing services ##############
+
+ # Register a service known as 'org.example.Jukebox'
+ my $service = $bus->export_service("org.example.Jukebox");
+
+
+=head1 DESCRIPTION
+
+Net::DBus provides a Perl API for the DBus message system.
+The DBus Perl interface is currently operating against
+the 0.32 development version of DBus, but should work with
+later versions too, providing the API changes have not been
+too drastic.
+
+Users of this package are either typically, service providers
+in which case the L<Net::DBus::Service> and L<Net::DBus::Object>
+modules are of most relevance, or are client consumers, in which
+case L<Net::DBus::RemoteService> and L<Net::DBus::RemoteObject>
+are of most relevance.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
package Net::DBus;
use 5.006;
@@ -19,33 +81,101 @@ use Net::DBus::Binding::Value;
use Net::DBus::Service;
use Net::DBus::RemoteService;
+=pod
+
+=item my $bus = Net::DBus->find(%params);
+
+Search for the most appropriate bus to connect to and
+return a connection to it. The heuristic used for the
+search is
+
+ - If DBUS_STARTER_BUS_TYPE is set to 'session' attach
+ to the session bus
+
+ - Else If DBUS_STARTER_BUS_TYPE is set to 'system' attach
+ to the system bus
+
+ - Else If DBUS_SESSION_BUS_ADDRESS is set attach to the
+ session bus
+
+ - Else attach to the system bus
+
+The optional C<params> hash can contain be used to specify
+connection options. The only support option at this time
+is C<nomainloop> which prevents the bus from being automatically
+attached to the main L<Net::DBus::Reactor> event loop.
+
+=cut
sub find {
my $class = shift;
- if (exists $ENV{DBUS_SESSION_BUS_ADDRESS} ||
- (exists $ENV{DBUS_STARTER_BUS_TYPE} &&
- $ENV{DBUS_STARTER_BUS_TYPE} eq "session")) {
- return $class->session;
- } elsif (exists $ENV{DBUS_SYSTEM_BUS_ADDRESS} ||
- (exists $ENV{DBUS_STARTER_BUS_TYPE} &&
- $ENV{DBUS_STARTER_BUS_TYPE} eq "system")) {
- return $class->system;
+ if ($ENV{DBUS_STARTER_BUS_TYPE} &&
+ $ENV{DBUS_STARTER_BUS_TYPE} eq "session") {
+ return $class->session(@_);
+ } elsif ($ENV{DBUS_STARTER_BUS_TYPE} &&
+ $ENV{DBUS_STARTER_BUS_TYPE} eq "system") {
+ return $class->system(@_);
+ } elsif (exists $ENV{DBUS_SESSION_BUS_ADDRESS}) {
+ return $class->session(@_);
} else {
return $class->system;
}
}
+=pod
+
+=item my $bus = Net::DBus->system(%params);
+
+Return a connection to the system message bus. Note that the
+system message bus is locked down by default, so unless appropriate
+access control rules are added in /etc/dbus/system.d/, an application
+may access services, but won't be able to export services.
+The optional C<params> hash can contain be used to specify
+connection options. The only support option at this time
+is C<nomainloop> which prevents the bus from being automatically
+attached to the main L<Net::DBus::Reactor> event loop.
+
+=cut
+
sub system {
my $class = shift;
return $class->_new(Net::DBus::Binding::Bus->new(type => &Net::DBus::Binding::Bus::SYSTEM), @_);
}
+=pod
+
+=item my $bus = Net::DBus->session(%params);
+
+Return a connection to the session message bus.
+The optional C<params> hash can contain be used to specify
+connection options. The only support option at this time
+is C<nomainloop> which prevents the bus from being automatically
+attached to the main L<Net::DBus::Reactor> event loop.
+
+=cut
+
sub session {
my $class = shift;
return $class->_new(Net::DBus::Binding::Bus->new(type => &Net::DBus::Binding::Bus::SESSION), @_);
}
+=pod
+
+=item my $bus = Net::DBus->new($address, %params);
+
+Return a connection to a specific message bus. The C<$address>
+parameter must contain the address of the message bus to connect
+to. An example address for a session bus might look like
+C<unix:abstract=/tmp/dbus-PBFyyuUiVb,guid=191e0a43c3efc222e0818be556d67500>,
+while one for a system bus would look like C<unix:/var/run/dbus/system_bus_socket>.
+The optional C<params> hash can contain be used to specify
+connection options. The only support option at this time
+is C<nomainloop> which prevents the bus from being automatically
+attached to the main L<Net::DBus::Reactor> event loop.
+
+=cut
+
sub new {
my $class = shift;
my $nomainloop = shift;
@@ -76,18 +206,77 @@ sub _new {
return $self;
}
+=pod
+
+=item my $connection = $bus->connection;
+
+Return a handle to the underlying, low level connection object
+associated with this bus. The returned object will be an instance
+of the L<Net::DBus::Binding::Bus> class. This method is not intended
+for use by (most!) application developers, so if you don't understand
+what this is for, then you don't need to be calling it!
+
+=cut
+
sub get_connection {
my $self = shift;
return $self->{connection};
}
+=pod
+
+=item my $service = $bus->get_service($name);
+
+Retrieves a handle for the remote service identified by the
+service name C<$name>. The returned object will be an instance
+of the L<Net::DBus::RemoteService> class.
+
+=cut
+
sub get_service {
my $self = shift;
- my $name = @_ ? shift : "org.freedesktop.Broadcast";
+ my $name = shift;
return Net::DBus::RemoteService->new($self, $name);
}
+=pod
+
+=item my $bool = $bus->has_service($name);
+
+Returns a true value if the bus has an active service
+with a name of C<$name>. Returns a false value, if it
+does not. NB services can disappear from the bus at
+any time, so be prepared to handle failure at a later
+time, even if this method returns true.
+
+=cut
+
+sub has_service {
+ my $self = shift;
+ my $name = shift;
+
+ my $dbus = $self->get_service("org.freedesktop.DBus");
+ my $bus = $dbus->get_object("/org/freedesktop/DBus");
+ my $services = $bus->ListNames;
+
+ foreach (@{$services}) {
+ return 1 if $_ eq $name;
+ }
+ return 0;
+}
+
+
+=pod
+
+=item my $service = $bus->export_service($name);
+
+Registers a service with the bus, returning a handle to
+the service. The returned object is an instance of the
+L<Net::DBus::Service> class.
+
+=cut
+
sub export_service {
my $self = shift;
my $name = shift;
@@ -224,36 +413,20 @@ sub _signal_func {
1;
__END__
-=head1 NAME
-
-DBus - Perl extension for the DBus message system
-
-=head1 SYNOPSIS
-
- use Net::DBus::Connection;
- use Net::DBus::Server;
+=pod
-=head1 ABSTRACT
-
-DBus provides a Perl API for the DBus message system.
-
-=head1 DESCRIPTION
-
-DBus provides a Perl API for the DBus message system.
-The DBus Perl interface is currently operating against
-the 0.30 development version of DBus. See the programs
-in the examples/ subdirectory for example of how to
-use the APIs
+=back
=head1 SEE ALSO
-L<Net::DBus::Connection>, L<Net::DBus::Server>, L<Net::DBus::Message>, L<Net::DBus::Reactor>,
-L<Net::DBus::Bus>, L<Net::DBus::Watch>, L<Net::DBus::Iterator>,
+L<Net::DBus>, L<Net::DBus::RemoteService>, L<Net::DBus::Service>,
+L<Net::DBus::RemoteObject>, L<Net::DBus::Object>,
+L<Net::DBus::Exporter>, L<Net::DBus::Dumper>, L<Net::DBus::Reactor>,
L<dbus-monitor(1)>, L<dbus-daemon-1(1)>, L<dbus-send(1)>, L<http://dbus.freedesktop.org>,
=head1 AUTHOR
-Daniel Berrange E<lt>dan at berrange.comE<gt>
+Daniel Berrange <dan at berrange.com>
=head1 COPYRIGHT AND LICENSE
--
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