<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># -*- perl -*-
#
# Copyright (C) 2004-2011 Daniel P. Berrange
#
# This program is free software; You can redistribute it and/or modify
# it under the same terms as Perl itself. Either:
#
# a) the GNU General Public License as published by the Free
#   Software Foundation; either version 2, or (at your option) any
#   later version,
#
# or
#
# b) the "Artistic License"
#
# The file "COPYING" distributed along with this file provides full
# details of the terms and conditions of the two licenses.

=pod

=head1 NAME

Net::DBus::Service - Provide a service to the bus for clients to use

=head1 SYNOPSIS

  package main;

  use Net::DBus;

  # Attach to the bus
  my $bus = Net::DBus-&gt;find;

  # Acquire a service 'org.demo.Hello'
  my $service = $bus-&gt;export_service("org.demo.Hello");

  # Export our object within the service
  my $object = Demo::HelloWorld-&gt;new($service);

  ....rest of program...

=head1 DESCRIPTION

This module represents a service which is exported to the message
bus. Once a service has been exported, it is possible to create
and export objects to the bus.

=head1 METHODS

=over 4

=cut


package Net::DBus::Service;

use 5.006;
use strict;
use warnings;

=item my $service = Net::DBus::Service-&gt;new($bus, $name);

Create a new service, attaching to the bus provided in
the C&lt;$bus&gt; parameter, which should be an instance of
the L&lt;Net::DBus&gt; object. The C&lt;$name&gt; parameter is the
qualified service name. It is not usually necessary to
use this constructor, since services can be created via
the C&lt;export_service&gt; method on the L&lt;Net::DBus&gt; object.

When C&lt;$name&gt; is not specified or is C&lt;undef&gt; then returned
handle to the service is identified only by the unique name
of client's connection to the bus.

=cut

sub new {
    my $class = shift;
    my $self = {};

    $self-&gt;{bus} = shift;
    $self-&gt;{service_name} = shift;
    $self-&gt;{objects} = {};

    bless $self, $class;

    if (not defined $self-&gt;get_service_name) {
        $self-&gt;{service_name} = $self-&gt;get_bus-&gt;get_unique_name;
        return $self;
    }

    $self-&gt;get_bus-&gt;get_connection-&gt;request_name($self-&gt;get_service_name);

    return $self;
}

=item my $bus = $service-&gt;get_bus;

Retrieves the L&lt;Net::DBus&gt; object to which this service is
attached.

=cut

sub get_bus {
    my $self = shift;
    return $self-&gt;{bus};
}

=item my $name = $service-&gt;get_service_name

Retrieves the qualified name by which this service is
known on the bus.

=cut

sub get_service_name {
    my $self = shift;
    return $self-&gt;{service_name};
}


sub _register_object {
    my $self = shift;
    my $object = shift;
    #my $wildcard = shift || 0;

#    if ($wildcard) {
#	$self-&gt;get_bus-&gt;get_connection-&gt;
#	    register_fallback($object-&gt;get_object_path,
#			      sub {
#				  $object-&gt;_dispatch(@_);
#			      });
#    } else {
	$self-&gt;get_bus-&gt;get_connection-&gt;
	    register_object_path($object-&gt;get_object_path,
				 sub {
				     $object-&gt;_dispatch(@_);
				 });
#    }
}


sub _unregister_object {
    my $self = shift;
    my $object = shift;

    $self-&gt;get_bus-&gt;get_connection-&gt;
	unregister_object_path($object-&gt;get_object_path);
}

1;

=pod

=back

=head1 AUTHOR

Daniel P. Berrange

=head1 COPYRIGHT

Copyright (C) 2005-2011 Daniel P. Berrange

=head1 SEE ALSO

L&lt;Net::DBus&gt;, L&lt;Net::DBus::Object&gt;, L&lt;Net::DBus::RemoteService&gt;

=cut
</pre></body></html>