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

Net-DBus documentation Contained in the Net-DBus distribution.

Index

Code Index:

NAME

Top

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

SYNOPSIS

Top

  package main;

  use Net::DBus;

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

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

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

  ....rest of program...

DESCRIPTION

Top

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.

METHODS

Top

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

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

my $bus = $service->get_bus;

Retrieves the Net::DBus object to which this service is attached.

my $name = $service->get_service_name

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

SEE ALSO

Top

Net::DBus, Net::DBus::Object, Net::DBus::RemoteService

Net-DBus documentation Contained in the Net-DBus distribution. 
# -*- perl -*-
#
# Copyright (C) 2004-2006 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.



package Net::DBus::Service;

use 5.006;
use strict;
use warnings;


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

    $self->{bus} = shift;
    $self->{service_name} = shift;
    $self->{objects} = {};
    
    bless $self, $class;

    $self->get_bus->get_connection->request_name($self->get_service_name);

    return $self;
}


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


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


sub _register_object {
    my $self = shift;
    my $object = shift;
    #my $wildcard = shift || 0;
    
#    if ($wildcard) {
#	$self->get_bus->get_connection->
#	    register_fallback($object->get_object_path,
#			      sub {
#				  $object->_dispatch(@_);
#			      });
#    } else {
	$self->get_bus->get_connection->
	    register_object_path($object->get_object_path,
				 sub {
				     $object->_dispatch(@_);
				 });
#    }
}


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

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

1;