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 <d...@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>d...@berrange.come<gt> +Daniel Berrange <d...@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 _______________________________________________ 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